VBA：如果存在特定工作表，如何保护它们？

Question

提前感谢大家的帮助。

我的代码可以在循环内的不同文件上运行，但是，这些文件有不同名称的选项卡。我需要保护一些标签（文件中可能存在也可能不存在）。

应该是这样的：

---

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

结束子

Answer 1

如果可能的话，你可以简单地使用这样的东西：

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 条件为存在。

让我知道它是否有效。