預先感謝大家的幫助。
我有在回圈中處理不同檔案的代碼，但是，這些檔案具有不同名稱的選項卡。我需要保護一些選項卡（檔案中可能存在也可能不存在）。
它會是這樣的：
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" & 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:\Files\Dept Produtos\Testes Macro Simulador\Arquivos para atualiza??o\"
fileNm = Dir(loopFolder & "*.xlsm")
Do While fileNm <> ""
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 & 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
這是我無法解決的部分：
作業表的名稱可以是“input dados”或“CDC”或“LEASING”。我想保護它們中的任何一個是否存在，如果不存在，則代碼恢復到下一行。
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:\Files\Dept Produtos\Testes Macro Simulador\Atualizados\"
name = wb.Sheets("infomacro").Range("b3").Value
wb.SaveAs Filename:=savefolder & name & ".xlsm"
wb.Close
Next
重置宏優化設定
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = Trueele
結束子
uj5u.com熱心網友回復：
如果可能，您可以簡單地使用以下內容：
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
之后，您可以簡單地使用另一個 if 和存在作為條件。
讓我知道它是否有效。
轉載請註明出處，本文鏈接：https://www.uj5u.com/qiye/372343.html