Ir ao conteúdo
  • Cadastre-se

FlaviaTaynara

Membros Juniores
  • Total de itens

    9
  • Registro em

  • Última visita

  • Qualificações

    N/D
  1. @osvaldomp varei isso. Muito obrigada pela ajuda e paciência. Bom final de semana
  2. @osvaldomp Bom dia, O codigo funcionou, porém o mesmo salvou em cima do arquivo ja salvo pelo Alert (CCISD 03.27.2020). Eu esqueci de mencionar que o nome do cliente é extraido de um outro programa e por isso tem essa parte no codigo para poder arrumar o nome como os times necessitao. savePath = Environ("userprofile") 'get unique path for every user CompanyName = ThisWorkbook.Sheets(1).Range("C1").Value CompanyName = Replace(CompanyName, "&", "") CompanyName = Replace(CompanyName, "/", "") CompanyName = Replace(CompanyName, "\", "") CompanyName = Replace(CompanyName, ":", "") CompanyName = Replace(CompanyName, "*", "") CompanyName = Replace(CompanyName, "?", "") CompanyName = Replace(CompanyName, Chr(34), "") CompanyName = Replace(CompanyName, "<", "") CompanyName = Replace(CompanyName, ">", "") CompanyName = Replace(CompanyName, "|", "") Somos 2 times: Level 1 e Level 2. O level 1 ira usar excel file (que neste momento tem outro nome, um nome generico) para fazer as investigacoes necesarias. Os dados como cliente e beneficiarios sao extraidos de um outro programa e transferido para o template do excel. Apos o time 1 terminar suas anotacoes o mesmo ira usar usar o botao salve file na aba Alert e automaticamente um novo arquivo sere salvo em uma pasta especifica neste caso e ("\Desktop\ Ingestigations\"). O time 2 ira receber o arquivo salvo pelo time 1 e comecara a trabalhar nele e apos terminar tambem ira usar o botao Save File (porém na aba do Level 2) para que o mesmo seja salvo tambem em uma local especificico ("\Desktop\ Ingestigations\"). Eu notei que: se na pasta de destino ("\Desktop\ Ingestigations\") do level 2 nao tiver o arquivo do time 1 salvo, ao apertar o botao save file na aba do level 2 o mesmo ira salver corretamente. porém se na pasta de destino ("\Desktop\ Ingestigations\") do level 2 ja existir o arquivo salvo pelo time 1 o botao ira apenas apenas salvar uma atualizacao do mesmo, salvando em cima do que arquivo que ja existe. Uma das opções que acho que poderia funcionar seria fazer outra pasta de destino para o time do level 2 ex: \Desktop\ Ingestigations Level 2\ ou mudar completamente o codigo do level 2. A unica coisa que o codigo do level 2 precisa fazer antes de salvar como um novo arquivo e novo nome é chegar se o screenshots estão no local correto e corrigir erros de ortografia, enato ira salvar na pasta de destino. ("\Desktop\ Ingestigations\"). ob: O time do level 2 normalmente nao faz nenhuma auteracao na aba do cliente e nem insere nenhum dado de outros programas, logo a data que se encontra na aba Cliente Review sera a data em que o time 1 salvou o arquivo (usando o botao da aba Alert). Obrigada pela paciencia comigo e por toda a ajuda.
  3. Desculpa acabei me empolgando. Neste momento estou revisando o codigo do Salve File da aba Alert XX.XX.XXXX (Level 2) que esta do modulo Level_2 e ja anotei varias partes que pode ser deletada. O que eu preciso é: Que quando o botao Save File da aba Alert XX.XX.XXXX (Level 2) funcione salvando um novo arquivo com mesmo nome apenas acrescentando (Level 2) na frente ex: CCISD 03.26.2020 (o botao save file na aba Alert XX.XX.XXXX criou este arquivo quando foi selecionado). O time do level 2 ira usar este arquivo criado por ele e fazer suas anotacoes na Aba do Level 2 e ira salvar novamente, pore neste momento usando o botao Save File disponivel na Aba Alert XX.XX.XXXX (Level 2) e o novo arquivo tera o nome de ex: CCISD 03.27.2020 (Level 2). preciso fazer como um novo arquivo com o mesmo nome que o anterior so acrescentando (Level 2 a frente) e chegar. Sub Save_Level_2_File() Dim ws As Worksheet Dim Client As ClientReview Alert1.Cells.CheckSpelling ClientReview.Cells.CheckSpelling If Application.ActiveWorkbook.Path = Environ("userprofile") & "\Desktop\Investigations" Then ActiveWorkbook.Save MsgBox " File has been saved successfully." Exit Sub End If Dim today As String Dim savePath As String Dim CompanyName As String Dim UserName As String ClientReview.Activate today = Format(Date, "MM.DD.YYYY") Range("C6").Value = today savePath = Environ("userprofile") 'get unique path for every user CompanyName = ThisWorkbook.Sheets(1).Range("C1").Value CompanyName = Replace(CompanyName, "&", "") CompanyName = Replace(CompanyName, "/", "") CompanyName = Replace(CompanyName, "\", "") CompanyName = Replace(CompanyName, ":", "") CompanyName = Replace(CompanyName, "*", "") CompanyName = Replace(CompanyName, "?", "") CompanyName = Replace(CompanyName, Chr(34), "") CompanyName = Replace(CompanyName, "<", "") CompanyName = Replace(CompanyName, ">", "") CompanyName = Replace(CompanyName, "|", "") UserName = Application.UserName Alert1.Visible = xlSheetVisible Alert1.Activate Range("C1").Value = UserName Alert1.Name = "Alert " & today & " (Level 2)" ' button save file Level 2 If Len(Dir(savePath & "\Desktop\Investigations", vbDirectory)) = 0 Then MkDir (savePath & "\Desktop\Investigations") End If On Error GoTo ErrorMessage ActiveWorkbook.SaveCopyAs Filename:=savePath & "\Desktop\Investigations\" & CompanyName & " " & today & " (Level 2)" & ".xls" MsgBox "File has been successfully saved to investigations folder in user's desktop." Exit Sub ErrorMessage: MsgBox "Something went wrong, file not saved!" End Sub CCISD 03.26.2020.xlsx adicionado 27 minutos depois @osvaldomp Ah esqueci de mencionar que o nome do arquivo é baseado no nome do Client name for search (Na coluna C linha 1) que se encontra na aba Client Review.
  4. @osvaldomp Bom dia, Tens razao, teu codigo esta funcionando perfeitamente. Notei que nao tem relação se a checkbox estiver selecionado ou nao, o Botao de Save File da aba Alert XX.XX.XXXX (Level 2) nao funciona quando o file ja salvo no Alert XX.XX.XXXX e é aberto novamente pelo time do Level 2 e ao tentar salvar o mesmo usando o Save File no Alert XX.XX.XXXX (Level 2). (porém isso é exatamente o que preciso corrigir, pois o time do Level 2 usa o arquivo salvo pelo Alert XX.XX.XXXX para fazer as mudancas necessarias e salva como um novo aquivo). Este codigo é o praticamente o mesmo para o botao Salve File no Alert XX.XX.XXXX preciso modificar umas coisas (como informações que se deve aparecer no closing note), porém essas mudancas nao irao interferir com o Botao salvar. Talvez tu consegue ver onde esta meu erro e o por que se uso o arquivo do excel ja salvo (ja com o nome alterado ex: Cien 03.26.2020 o mesmo noa pode ser salvo como um novo arquivo alterando o nome como se é esperado ex: Cien 03.26.2020 (Level 2) ?? mais uma vez muito obrigada. 'Salve Fale na Aba Alert XX.XX.XXXX Sub SaveFile() Dim ws As Worksheet Call RemLink If ClientReview.Visible = True Then Set Client = ClientReview Else For Each ws In ActiveWorkbook.Worksheets If ws.Name Like "Client Review*" Then Set Client = ws End If Next ws End If If CheckForPics = False Then Exit Sub If CalculationSheet.Range("AP1").Value = True Or CalculationSheet.Range("AP2").Value = True Or CalculationSheet.Range("AP3").Value = True Or CalculationSheet.Range("AP4").Value = True Or CalculationSheet.Range("AP5").Value = True Then If CheckforWC = False Then Exit Sub End If If NotFilled = False Then Exit Sub If NotFilledRules = False Then Exit Sub If NotFilledClient = False Then Exit Sub If Client.Range("H1").Value <> "" Then If CalculationSheet.Range("AP6").Value = True Then Debug.Print "Works" If CheckForClientWC = False Then Exit Sub End If If CheckForClientNegative = False Then Exit Sub End If Alert.Cells.CheckSpelling ClientReview.Cells.CheckSpelling If Application.ActiveWorkbook.Path = Environ("userprofile") & "\Desktop\Investigations" Then ActiveWorkbook.Save MsgBox " File has been saved successfully." Exit Sub End If ClientReview.Activate today = Format(Date, "MM.DD.YYYY") Range("C6").Value = today savePath = Environ("userprofile") 'get unique path for every user CompanyName = ThisWorkbook.Sheets(1).Range("C1").Value CompanyName = Replace(CompanyName, "&", "") CompanyName = Replace(CompanyName, "/", "") CompanyName = Replace(CompanyName, "\", "") CompanyName = Replace(CompanyName, ":", "") CompanyName = Replace(CompanyName, "*", "") CompanyName = Replace(CompanyName, "?", "") CompanyName = Replace(CompanyName, Chr(34), "") CompanyName = Replace(CompanyName, "<", "") CompanyName = Replace(CompanyName, ">", "") CompanyName = Replace(CompanyName, "|", "") UserName = Application.UserName Alert.Visible = xlSheetVisible Alert.Activate Range("C1").Value = UserName Alert.Name = "Alert " & today If Len(Dir(savePath & "\Desktop\Investigations", vbDirectory)) = 0 Then MkDir (savePath & "\Desktop\Investigations") End If On Error GoTo ErrorMessage ActiveWorkbook.SaveCopyAs Filename:=savePath & "\Desktop\Investigations\" & CompanyName & " " & today & ".xls" MsgBox "File has been successfully saved to investigations folder in user's desktop." Exit Sub ErrorMessage: MsgBox "Something went wrong, file not saved!" End Sub Sub SaveFileWithoutAlertTab() Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.AskToUpdateLinks = False 'For less lag Call RemLink If CalculationSheet.Range("AP6").Value = True Then If CheckForClientWC = False Then Exit Sub End If If CheckForClientNegative = False Then Exit Sub If NotFilledClient = False Then Exit Sub ClientReview.Cells.CheckSpelling ClientReview.Activate today = Format(Date, "MM.DD.YYYY") Range("C6").Value = today savePath = Environ("userprofile") 'get unique path for every user CompanyName = ThisWorkbook.Sheets(1).Range("C1").Value CompanyName = Replace(CompanyName, "&", "") CompanyName = Replace(CompanyName, "/", "") CompanyName = Replace(CompanyName, "\", "") CompanyName = Replace(CompanyName, ":", "") CompanyName = Replace(CompanyName, "*", "") CompanyName = Replace(CompanyName, "?", "") CompanyName = Replace(CompanyName, Chr(34), "") CompanyName = Replace(CompanyName, "<", "") CompanyName = Replace(CompanyName, ">", "") CompanyName = Replace(CompanyName, "|", "") UserName = Application.UserName If Len(Dir(savePath & "\Desktop\Investigations", vbDirectory)) = 0 Then MkDir (savePath & "\Desktop\Investigations") End If Alert.Visible = xlSheetVeryHidden On Error GoTo ErrorMessage ActiveWorkbook.SaveCopyAs Filename:=savePath & "\Desktop\Investigations\" & CompanyName & " " & today & ".xls" Alert.Visible = xlSheetVisible Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.AskToUpdateLinks = True MsgBox "File has been successfully saved to investigations folder in user's desktop." Exit Sub ErrorMessage: MsgBox "Something went wrong, file not saved!" End Sub Sub CopyPasteFromDownloadedClientReviewSheet() Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.AskToUpdateLinks = False 'For less lag ClientReviewTabIsHided = False ClientReview.Visible = xlSheetVeryHidden ClientReview.Name = "Original Client Review" On Error GoTo ErrorTrue Worksheets(1).Activate Dim ws As Worksheet Dim DownloadedClientReviewSheet As Worksheet today = Format(Date, "MM.DD.YYYY") For Each ws In ThisWorkbook.Worksheets ws.Activate If ws.Name Like "Client Review*" Then Set DownloadedClientReviewSheet = ActiveSheet DownloadedClientReviewSheet.Name = "Client Review" & " " & today GoSub CopyPasteFromDownloadedClientReview Exit For End If Next ws CopyPasteFromDownloadedClientReview: Range("C1:C2").Select Selection.Copy Alert.Activate Range("C2").PasteSpecial xlPasteValues 'Unmerge client summary in Alert sheet to make it available for pasting 'Range("K16").UnMerge 'DownloadedClientReviewSheet.Activate 'DownloadedClientReviewSheet.Range("H1:H2").Value = "" 'Range("J3:L8").UnMerge 'Range("J3").Copy 'Alert.Activate 'Range("K16").PasteSpecial xlPasteValues 'Range("K16:Q22").Merge 'DownloadedClientReviewSheet.Activate Alert.Range("K16").Value = "='" & DownloadedClientReviewSheet.Name & "'!J3" 'Range("J3:L8").Merge 'Alert.Activate ClientReviewTabIsHided = True Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.AskToUpdateLinks = True Exit Sub ErrorTrue: ClientReview.Visible = xlSheetVisible ClientReview.Name = "Client Review" Alert.Activate Range("K16:Q22").Merge MsgBox "No manually added sheets identified." End Sub Sub ClearAll() Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.AskToUpdateLinks = False 'For less lag 'Delete all pictures Dim Sh As Shape Dim sheetnumber As Integer Dim ws As Worksheet Dim starting_ws As Worksheet VBanswer = MsgBox("Do you want to refresh the template?", vbYesNo, "Refresh Template") If VBanswer = vbYes Then GoSub ClearOut Else Exit Sub End If ClearOut: Alert.Visible = xlSheetVisible Alert.Name = "Alert XX.XX.XXXX" ClientReview.Visible = xlSheetVisible ClientReview.Name = "Client Review" Worksheets(1).Select Set starting_ws = ActiveSheet For Each ws In ThisWorkbook.Worksheets ws.Activate If ws.Name <> "Client Review" And ws.Name <> "Alert XX.XX.XXXX" And ws.Name <> "Closing Notes" And ws.Name <> "EmailData" And ws.Name <> "Red Flags" And ws.Name <> "AutoRules" And ws.Name <> "PivotBene" And ws.Name <> "Version Control" And ws.Name <> "Clc" And ws.Name <> "Countries" And ws.Name <> "Transaction Details" And ws.Name <> "Pivot" And ws.Name <> "Business Rule Justifications" And ws.Name <> "12 Months" And ws.Name <> "RFI Submition Contacts" And ws.Name <> "RFI Questions" And ws.Name <> "Exceptions" And ws.Name <> "12_Months_Pivot" Then ActiveSheet.Delete End If Next 'Dim wbBook As Workbook 'Dim nName As Name 'Set wbBook = ActiveWorkbook 'For Each nName In wbBook.Names 'nName.Delete 'Next nName For sheetnumber = 1 To Sheets.count For Each Sh In Sheets(sheetnumber).Shapes If Sh.Type = msoPicture Then Sh.Delete Next Next sheetnumber 'clear named ranges 'CLIENT REVIEW TAB Sheets("Client Review").Activate Range("C1:C3").Value = "" Range("C6").Value = "" Range("H1:H2").Value = "" Range("G8:H12").Value = "" Range("J3").Value = "The client has been with WUBS since XXX and has been incorporated since MMDDYY. The expected average transaction volume in currency is YYY and the expected average frequency is ZZZ payments YXX. The client transacts with the following location(s) XXX. The client [ClientDescription] and intends to use WUBS for [PayPurpose]. Further information is located in client's Sales Force profile." 'comments Sheets("Client Review").Range("C214:G217").Value = "" Sheets("Client Review").Range("C150:G153").Value = "" Sheets("Client Review").Range("C108:G111").Value = "" Sheets("Client Review").Range("g59:G65").Value = "" Range("C59:F59").FormulaR1C1 = "=IF(R[-51]C[4]<>"""",R[-51]C[4],""UBO 1"")" Range("C60:F60").FormulaR1C1 = "=IF(R[-51]C[4]<>"""",R[-51]C[4],""UBO 2"")" Range("C61:F61").FormulaR1C1 = "=IF(R[-51]C[4]<>"""",R[-51]C[4],""UBO 3"")" Range("C62:F62").FormulaR1C1 = "=IF(R[-51]C[4]<>"""",R[-51]C[4],""UBO 4"")" Range("C63:F63").FormulaR1C1 = "=IF(R[-51]C[4]<>"""",R[-51]C[4],""UBO 5"")" Range("C64:F64").FormulaR1C1 = "=IF(R[-63]C[5]<>"""",R[-63]C[5],""Client name for search"")" Range("C65:F65").FormulaR1C1 = "=IF(R[-63]C[5]<>"""",R[-63]C[5],""Trading name for search"")" 'ALERT TAB Alert.Activate Range("C1").Value = "" Range("H2:L6").Value = "" Range("O2").Value = "" Range("B16").Value = CalculationSheet.Range("Default_Closing_Notes").Value Range("K16:Q22").Merge Range("C2").FormulaR1C1 = "=IF('Client Review'!R[-1]C<>"""",'Client Review'!R[-1]C,"""")" Range("C3").FormulaR1C1 = "=IF('Client Review'!R[-1]C<>"""",'Client Review'!R[-1]C,"""")" Range("K16").FormulaR1C1 = "='Client Review'!R[-13]C[-1]" Range("C66").FormulaR1C1 = "=IF(R[-64]C[5]<>"""",R[-64]C[5],""Bene 1"")" Range("C67").FormulaR1C1 = "=IF(R[-64]C[5]<>"""",R[-64]C[5],""Bene 2"")" Range("C68").FormulaR1C1 = "=IF(R[-64]C[5]<>"""",R[-64]C[5],""Bene 3"")" Range("C69").FormulaR1C1 = "=IF(R[-64]C[5]<>"""",R[-64]C[5],""Bene 4"")" Range("C70").FormulaR1C1 = "=IF(R[-64]C[5]<>"""",R[-64]C[5],""Bene 5"")" 'Delete all comments Alert.Range("C318:G321").Value = "" Alert.Range("C270:G273").Value = "" Alert.Range("C230:G233").Value = "" Alert.Range("C189:G192").Value = "" Alert.Range("C148:G151").Value = "" Alert.Range("C107:G110").Value = "" Alert.Range("G66:G70").Value = "" Countries.Visible = False Grid.Visible = False Pivot.Visible = False CalculationSheet.Visible = False Avarage.Visible = False PivotBene.Visible = False AutoRules.Visible = False RedFlagss.Visible = False ClientReview.Range("C23").Value = "" CalculationSheet.Range("B100:B121").Value = "FALSE" CalculationSheet.Range("OutTransactionsStartDate").Value = "XXZ" CalculationSheet.Range("OutTransactionsEndDate").Value = "YYX" CalculationSheet.Range("broken_rules").Value = "ZZX" CalculationSheet.Range("rules_count").Value = "" CalculationSheet.Range("BeneficiaryInfoFromTable").Value = CalculationSheet.Range("K7").Value CalculationSheet.Rows("150:" & Rows.count).ClearContents CalculationSheet.Range("RulesForWhiteListing").Value = "" CalculationSheet.Range("RuleCountToWhiteList").Value = "" CalculationSheet.Range("RulesJustification").Value = CalculationSheet.Range("K9").Value CalculationSheet.Range("Ending").Value = CalculationSheet.Range("K3").Value CalculationSheet.Range("redflags").Value = CalculationSheet.Range("K5").Value CalculationSheet.Range("Benecc").Value = "XXX" CalculationSheet.Range("C6").Value = "" CalculationSheet.Range("AP1:AP6").Value = "False" ClientReview.Range("D67").Value = "" EmailData.Cells.Clear Pivot.Cells.Clear Grid.Cells.Clear Avarage.Cells.Clear Alert.Range("P2").Value = "" Alert.Range("D32").Value = "" CalculationSheet.Range("I2:I" & CalculationSheet.Cells(Rows.count, 9).End(xlUp).Row).Value = "" ClientReview.Range("C67").Value = "" ClientReview.Range("D67").Value = "" ClientReview.Range("C114").Value = "" CalculationSheet.Range("C3:H30").Value = "" avarage_pivot.Visible = False On Error Resume Next PivotBene.PivotTables("BeneNames").TableRange2.Clear On Error GoTo 0 On Error Resume Next ActiveWorkbook.SlicerCaches("Slicer_Bene_Names").Delete On Error GoTo 0 On Error Resume Next ActiveWorkbook.SlicerCaches("Slicer_Dates").Delete On Error GoTo 0 On Error Resume Next ActiveWorkbook.SlicerCaches("Slicer_Bene_Name").Delete On Error GoTo 0 On Error Resume Next ActiveWorkbook.SlicerCaches("Slicer_Bene_Name1").Delete On Error GoTo 0 AutoRules.Range("E2:Z50").Clear PivotBene.Rows("2:" & Rows.count).ClearContents avarage_pivot.Rows.Delete Application.GoTo Reference:=Range("a1"), Scroll:=True Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.AskToUpdateLinks = True MsgBox "Template has been refreshed.", vbOKOnly, "Information" End Sub Private Sub Workbook_Open() Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.AskToUpdateLinks = False Dim openPath, FilePath As String Dim data_file As Workbook Set WBMain = ThisWorkbook openPath = Environ("userprofile") FilePath = (openPath & "\Box\WUBS GAI & SAR REPORTING\Distribution lists (IRIS TMS case, World-Check, Fintrac)\Distribution WU WAY\Data for Templates.xlsx") If CalculationSheet.Range("A25").Value <> FileDateTime(FilePath) Then exceptions.Rows.Clear rfi_contacts.Rows.Clear rfi_questions.Rows.Clear Set data_file = Workbooks.Open(openPath & "\Box\WUBS GAI & SAR REPORTING\Distribution lists (IRIS TMS case, World-Check, Fintrac)\Distribution WU WAY\Data for Templates.xlsx") data_file.Sheets("RFI Submition Contacts").Range("A:M").Copy rfi_contacts.Range("A1") data_file.Sheets("RFI Questions").Range("A:C").Copy rfi_questions.Range("A1") data_file.Sheets("Rule Exceptions").Range("A:C").Copy exceptions.Range("A1") data_file.Close CalculationSheet.Range("A25").Value = FileDateTime(FilePath) End If Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.AskToUpdateLinks = True End Sub -- ----------- -- 'Salve File na Aba Alert XX.XX.XXXX (Level 2) Option Explicit Sub Save_Level_2_File() Dim ws As Worksheet Dim Client As ClientReview Call RemLink2 If ClientReview.Visible = True Then Set Client = ClientReview Else For Each ws In ActiveWorkbook.Worksheets If ws.Name Like "Client Review*" Then Set Client = ws End If Next ws End If If CheckForPics2 = False Then Exit Sub If CalculationSheet.Range("AR1").Value = True Or CalculationSheet.Range("AR2").Value = True Or CalculationSheet.Range("AR3").Value = True Or CalculationSheet.Range("AR4").Value = True Or CalculationSheet.Range("AR5").Value = True Then If CheckforWC = False Then Exit Sub End If If NotFilled = False Then Exit Sub If NotFilledRules = False Then Exit Sub If NotFilledClient = False Then Exit Sub If Client.Range("H1").Value <> "" Then If CalculationSheet.Range("AR6").Value = True Then Debug.Print "Works" If CheckForClientWC = False Then Exit Sub End If If CheckForClientNegative = False Then Exit Sub End If Alert1.Cells.CheckSpelling ClientReview.Cells.CheckSpelling If Application.ActiveWorkbook.Path = Environ("userprofile") & "\Desktop\Investigations" Then ActiveWorkbook.Save MsgBox " File has been saved successfully." Exit Sub End If Dim today As String Dim savePath As String Dim CompanyName As String Dim UserName As String ClientReview.Activate today = Format(Date, "MM.DD.YYYY") Range("C6").Value = today savePath = Environ("userprofile") 'get unique path for every user CompanyName = ThisWorkbook.Sheets(1).Range("C1").Value CompanyName = Replace(CompanyName, "&", "") CompanyName = Replace(CompanyName, "/", "") CompanyName = Replace(CompanyName, "\", "") CompanyName = Replace(CompanyName, ":", "") CompanyName = Replace(CompanyName, "*", "") CompanyName = Replace(CompanyName, "?", "") CompanyName = Replace(CompanyName, Chr(34), "") CompanyName = Replace(CompanyName, "<", "") CompanyName = Replace(CompanyName, ">", "") CompanyName = Replace(CompanyName, "|", "") UserName = Application.UserName Alert1.Visible = xlSheetVisible Alert1.Activate Range("C1").Value = UserName Alert1.Name = "Alert " & today & " (Level 2)" ' button save file Level 2 If Len(Dir(savePath & "\Desktop\Investigations", vbDirectory)) = 0 Then MkDir (savePath & "\Desktop\Investigations") End If On Error GoTo ErrorMessage ActiveWorkbook.SaveCopyAs Filename:=savePath & "\Desktop\Investigations\" & CompanyName & " " & today & " (Level 2)" & ".xls" MsgBox "File has been successfully saved to investigations folder in user's desktop." Exit Sub ErrorMessage: MsgBox "Something went wrong, file not saved!" End Sub Sub CopyPasteFromDownloadedClientReviewSheet() Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.AskToUpdateLinks = False 'For less lag ClientReviewTabIsHided = False ClientReview.Visible = xlSheetVeryHidden ClientReview.Name = "Original Client Review" On Error GoTo ErrorTrue Worksheets(1).Activate Dim ws As Worksheet Dim DownloadedClientReviewSheet As Worksheet today = Format(Date, "MM.DD.YYYY") For Each ws In ThisWorkbook.Worksheets ws.Activate If ws.Name Like "Client Review*" Then Set DownloadedClientReviewSheet = ActiveSheet DownloadedClientReviewSheet.Name = "Client Review" & " " & today & "" & "(Level 2)" GoSub CopyPasteFromDownloadedClientReview Exit For End If Next ws CopyPasteFromDownloadedClientReview: Range("C1:C2").Select Selection.Copy Alert1.Activate Range("C2").PasteSpecial xlPasteValues 'Unmerge client summary in Alert sheet to make it available for pasting 'Range("K16").UnMerge 'DownloadedClientReviewSheet.Activate 'DownloadedClientReviewSheet.Range("H1:H2").Value = "" 'Range("J3:L8").UnMerge 'Range("J3").Copy 'Alert.Activate 'Range("K16").PasteSpecial xlPasteValues 'Range("K16:Q22").Merge 'DownloadedClientReviewSheet.Activate Alert.Range("K16").Value = "='" & DownloadedClientReviewSheet.Name & "'!J3" 'Range("J3:L8").Merge 'Alert.Activate ClientReviewTabIsHided = True Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.AskToUpdateLinks = True Exit Sub ErrorTrue: ClientReview.Visible = xlSheetVisible ClientReview.Name = "Client Review" Alert.Activate Range("K16:Q22").Merge MsgBox "No manually added sheets identified." End Sub Sub RemLink2() 'Excel VBA remove links from workbook. Dim ar As Variant Dim i As Integer ar = ActiveWorkbook.LinkSources(1) On Error Resume Next 'Trap error For i = 1 To UBound(ar) 'Excel VBA loop throuh links ActiveWorkbook.BreakLink ar(i), xlLinkTypeExcelLinks Next i On Error GoTo 0 End Sub Function CheckForPics2() As Boolean Dim ReturnValue As Boolean Dim nm As String Dim picBox As Integer Dim i As Long Dim tnm As String CheckForPics2 = True For i = 2 To 6 If Range("H" & i).Value <> "" Then picBox = i ReturnValue = CheckPic2(picBox) Dim result As String If ReturnValue = False Then tnm = CalculationSheet.Range("W" & i).Value result = MsgBox("No screenshots for " & tnm & " were found." & vbNewLine & "Do you still want to save file?", vbYesNo + vbQuestion + vbDefaultButton2) If result = vbNo Then CheckForPics2 = False Exit For Else: CheckForPics2 = True End If Else: CheckForPics2 = True End If Else Exit For End If Next i End Function Function CheckPic2(xRg As Integer) As Boolean Dim Client As Object Dim xpicRg As Range Dim nRg As String Dim nRg1 As Integer Dim nRg2 As Integer Dim ws As Worksheet If ClientReview.Visible = True Then Set Client = ClientReview Else For Each ws In ActiveWorkbook.Worksheets If ws.Name Like "Client Review*" Then Set Client = ws End If Next ws End If If xRg < 7 Then Alert1.Activate Else Client.Activate End If nRg = CalculationSheet.Range("V" & xRg).Value nRg1 = Split(nRg, ":")(0) nRg2 = Split(nRg, ":")(1) Debug.Print "ngr1: " & nRg1 Debug.Print "nrg2: " & nRg2 Dim xPic As Object For Each xPic In ActiveSheet.Pictures Debug.Print "xPic: " & xPic.TopLeftCell.Row If xPic.TopLeftCell.Row >= nRg1 And xPic.TopLeftCell.Row <= nRg2 Then Debug.Print "Ok" CheckPic2 = True Exit For Else CheckPic2 = False End If Next End Function Function NotFilled2() As Boolean Dim vl As String Dim Mnm As String Dim spos As Long Dim i As Integer Dim lenghts As Integer Dim result As Integer For i = 2 To 10 vl = CalculationSheet.Range("Z" & i).Value Mnm = CalculationSheet.Range("AA" & i).Value If InStr(Alert1.Range("B16").Value, vl) Then Alert1.Activate Alert1.Range("B16").Select spos = InStr(Alert1.Range("B16").Value, vl) lenghts = Len(vl) Alert1.Range("B16").Characters(Start:=spos, Length:=lenghts).Font.ColorIndex = 3 Alert1.Range("B16").Characters(Start:=spos, Length:=lenghts).Font.Bold = True result = MsgBox(Mnm & " was not entered in Closing Notes." & vbNewLine & "Do you still want to save file?", vbYesNo + vbQuestion + vbDefaultButton2) If result = vbYes Then NotFilled2 = True Else NotFilled2 = False Exit For End If Else: NotFilled2 = True End If Next i End Function
  5. @osvaldomp Muito Obrigada, Muito Obrigada, esta funcionando perfeitamente. Eu criei um Botao para iniciar o macro e assign o Macro a ele e esta funcionando perfeitamente. porém, eu notei que se alguma Checkbox da coluna M (L2) estiver selecionanda quando clico no botao Save File (no alert XX.XX.XXXX (Level 2) ) o mesmo nao funciona (ele salva o arquivo como se fosse a aba Alert XX.XX.XXXX, ou seja ele salva sobre o arquivo que ja estava salvo como o nome (do alerta Data ) sem o (Level 2) no final. teria algum motivo para isso? Ja se nenhuma checkbox estiver selecionada o botao Salve File da aba Alert XX.XX.XXXX (Level 2) funcionando perfeitamente como se deve. A maneira que os arvivos devem salvar o arquivo quando for clicado: No me do alerta + data (por exemplo o nome do alerta é "Cien") Se o botao Save File na aba Alert XX.XX.XXXX for selecionado o arquivo sera automaticamente salvo como: Cien 03.26.2020 Se o botao Save File na aba Alert XX.XX.XXXX (Level 2) for selecionado o arquivo sera automaticamente salvo como: Cien 03.26.2020 (Level 2) Seria possivel por uma linha no codigo para que se a checkbox esteja ou nao selecionada nao afete na hora que o save file botao do Alert XX.XX.XXXX (Level 2) seja selecionado? Obrigada pelo seu tempo.
  6. @osvaldomp consegui anexar o arquivo :) (mas o macro nao aparece, porém ja da para ter uma ideia) @Patropi Bom dia, Muito obrigada pela ajuda. A primeira parte esta funcionando perfeitamente, porém nao consigo corrigir a formula para as informações aparecerem na tabela da aba Alert XX.XX.XXXX (Level 2). eu tentei esta formula. =IFERROR(INDEX(ALERT XX.XX.XXXX!$H$2:$H$7,MATCH(ROW(A1),Clc!$AT$2:$AT$7,0))),'')&'' ROW(A1) nao entendi esta parte da formula. (meu excel esta em inglês normalmente quando tenho " no meu seria ') consegui anexar o excel file (porém o macro nao aparece nenhum...) eu creio que se fosse VBA nao teria problema quando o nome da aba muda. A aba sempre que clica no botao salvar ira mudar o nome dapara a cada do dia (entao nao sei se isso aferatia as checkbox). muito obrigada pela ajuda checkbox1.xlsx
  7. @osvaldomp Infelizmente o meu excel esta restrito e mesmo que coleque o arquivo aqui nao conseguira abrir em outro computador. sim voce esta correto, Alert e Alert1 sao os nomes da tab (irei colocar um print melhor). O que quero é copiar as informações que esteja disponivel na tabela da tab Alert (porém apenas se o checkbox estiver selecionado na coluna M (L2)). Sinceramente nao sei usar checkbox, nao sei se para isso necessito o form controls ou activeXcontrol. muito Obrigada.
  8. Ola pessoal. Desculpe usar esse mesmo post, mas minha duvida esta relacionada. Sou nova no VBA e nao sei nada sobre checkbox, pesquisei em varios sites e tentei varios codigos, porém nenhum funciona como preciso. Eu tenho um workbook com varias tabs, porém necessiro copiar informações de uma tabela na tab Alert para a mesma tabela na Tab Alert1 somente se a checkbox na coluna L2 estiver selecionada. (posso usar um botao na tab Alert1 para copiar as linhas da tabela que tiver o checkbox selecionado na colina L2). obrigada

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

montagem2018-capa-newsletter2.jpg

PROMOÇÃO DE QUARENTENA

De R$ 39,90 por apenas R$ 19,90 só até as 23h59min deste domingo 29/03/2020

CLIQUE AQUI E COMPRE AGORA MESMO!