Блог

Заранее благодарю вас за помощь каждого.

У меня есть код, который работает с разными файлами внутри цикла, однако у этих файлов есть вкладки с разными именами. Мне нужно будет защитить некоторые вкладки (которые могут существовать или не существовать в файлах).

Это было бы что-то вроде этого:

 Sub AtualizarCOFAGRO()   'this sets your template workbook/worksheet Dim copyWB As Workbook Dim copyWS As Worksheet Dim rInfo As Range  Set copyWB = Workbooks("Atualização de COF") Set copyWS = copyWB.Sheets("Cadastro COF") Set rInfo = copyWS.Range(Cells(1, 1), Cells(copyWS.Range("A" amp; Rows.Count).End(xlUp).Row, Cells(1, Columns.Count).End(xlToLeft).Column)) 'copiar todas as linhas e colunas com valores do arquivo   'this creates a collection of all filenames to be processed Dim loopFolder As String Dim fileNm As Variant Dim myFiles As New Collection   'Optimize Macro Speed  Application.ScreenUpdating = False  Application.EnableEvents = False  Application.Calculation = xlCalculationManual  Application.AskToUpdateLinks = False  Application.DisplayAlerts = False  '''don't forget the backslash before the final double-quote below  loopFolder = "J:FilesDept ProdutosTestes Macro SimuladorArquivos para atualização" fileNm = Dir(loopFolder amp; "*.xlsm")  Do While fileNm lt;gt; "" myFiles.Add fileNm  fileNm = Dir  Loop   'this loops through all filenames and copies your copyWS to the beginning  Dim wb As Workbook For Each fileNm In myFiles  Set wb = Workbooks.Open(Filename:=(loopFolder amp; fileNm))  wb.Unprotect "Senha453" 'desbloquear planilha    wb.Sheets("infomacro").Range("B2").ClearContents  wb.Sheets("Cadastro COF").Cells.Clear 'limpar toda planilha dos arquivos abertos no loop  rInfo.Copy  wb.Sheets("Cadastro COF").Range("A1").PasteSpecial xlPasteAll  wb.Sheets("infomacro").Range("B2").Value = Date  wb.Sheets("infomacro").Range("B2").NumberFormat = "dd/mm/yyyy"  wb.Sheets("infomacro").Visible = False  wb.Sheets("Cadastro COF").Visible = False    Application.Calculation = xlCalculationAutomatic    wb.Protect "Senha453" 'bloquear planilha     

это та часть, которую я не могу решить:

название листа может быть «ввод dados», «CDC» или «ЛИЗИНГ». Я хотел бы защитить, если какой-либо из них существует, если нет, код переходит к следующей строке.

 wb.Sheets("input dados").Protect "Senha453"  **or** wb.Sheets("LEASING").Protect "Senha453" **or** wb.Sheets("CDC").Protect "Senha453"    

Затем следует

 Calculate  wb.Save      Dim inf As Worksheet  Dim name As String  Dim savefolder As String    Set inf = wb.Sheets("Cadastro COF")  savefolder = "J:FilesDept ProdutosTestes Macro SimuladorAtualizados"  name = wb.Sheets("infomacro").Range("b3").Value    wb.SaveAs Filename:=savefolder amp; name amp; ".xlsm"   wb.Close   Next  

Сброс Настроек Оптимизации Макросов

 Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.DisplayAlerts = True Application.AskToUpdateLinks = Trueele  

Конец Суб

Если это возможно, вы можете просто использовать что-то вроде этого:

 On Error Resume Next wb.Sheets("input dados").Protect "Senha453" wb.Sheets("LEASING").Protect "Senha453" wb.Sheets("CDC").Protect "Senha453" On Error goto 0 'Or any other error management  

Если рабочий лист существует, он защитит его. Если нет, он просто перейдет на следующую строку. Вы можете проверить, существует ли книга на самом деле, но для ее запуска потребуется больше времени, поэтому, если вам действительно не нужно знать, существует она или нет, это должен сделать приведенный выше код. Если вам нужно проверить, существует ли он, это будет что-то вроде этого:

 dim ws as Worksheet dim exist as Boolean exist = False For Each ws in wb.Worksheets  If ws.Name= "NameYouWantToFind"  exist = True  End If Next ws  

После этого вы можете просто использовать другое, если с условием «существует как».

Дай мне знать, если это сработает.