用于保护文件夹中xls中的所有非空白单元格的宏

Question

Sub Divide() 
Dim fPath As String 
Dim fName As String 
Dim wb    As Workbook 
Dim ws As Worksheet 
Dim pwd As String 
pwd = "can" ' Put your password here
 'Setup
Application.ScreenUpdating = False 
fPath = "C:Documents and SettingsTRSECCAN2011Excel" 'remember final  in this string
fName = Dir(fPath & "*.xls") 'start a list of filenames
Do While Len(fName) > 0 
    Set wb = Workbooks.Open(fPath & fName) 'open found file
    With ActiveSheet 
        Selection.SpecialCells(xlCellTypeBlanks).Select 
        Selection.Locked = False 
        .Protect Password:=pwd 
    End With 
    wb.Close True 'close/save
    fName = Dir 'get next filename
Loop 
Application.ScreenUpdating = True 
End Sub

我需要一个宏来打开文件夹中的所有工作簿，然后为每个工作表选择空白单元格，然后使它们解锁，然后使用给定的密码保护工作表。

上面的代码只对活动的工作表执行此操作，我怎样才能为宏打开的所有工作表执行此操作？ 无论如何，我可以将以下内容部署到代码中

 UpdateLinks:=xlUpdateLinksNever

提前致谢

Answer 1

以下是您的代码应该是什么样子(您应该删除不需要的Select：

Sub Divide() 
Dim fPath As String 
Dim fName As String 
Dim wb    As Workbook 
Dim ws As Worksheet 
Dim pwd As String 
pwd = "can" ' Put your password here
 'Setup
Application.ScreenUpdating = False 
fPath = "C:Documents and SettingsTRSECCAN2011Excel" 'remember final  in this string
fName = Dir(fPath & "*.xls") 'start a list of filenames
Do While Len(fName) > 0 
    Set wb = Workbooks.Open(fPath & fName, UpdateLinks:=xlUpdateLinksNever) 'open found file
    For Each ws in wb.Worksheets    
        With ws
           .SpecialCells(xlCellTypeBlanks).Locked = False 
           .Protect Password:=pwd 
        End With 
    Next ws
    wb.Close True 'close/save
    fName = Dir 'get next filename
Loop 
Application.ScreenUpdating = True 
End Sub

有关更新链接，请参阅

ozgrid以获取更新链接，请参阅Chip Pearson以获取循环

Answer 2

此代码将循环浏览活动工作簿中的每个工作表，显示工作表名称和单元格 A1 的值到即时窗口。

Sub DisplayWSNames()
  Dim InxWS As Integer
  For InxWS = 1 To Sheets.Count
    With Sheets(Inx)
      Debug.Print "Cell A1 of Sheet " & .Name & " = " & .Cells(1, 1)
    End With
  Next
End Sub

我自己不链接工作簿，因此无法帮助您解决问题的这一部分。

Answer 3

Sub Divide()
Dim fPath As String
Dim fName As String
Dim wb    As Workbook
Dim ws As Worksheet
Dim pwd As String
pwd = "can" ' Put your password here
'Setup
 Application.ScreenUpdating = False
 fPath = "C:Documents and SettingsTRSECCAN2011Excel"   'remember final  in this   string
 fName = Dir(fPath & "*.xls")    'start a list of filenames
Do While Len(fName) > 0
Set wb = Workbooks.Open(fPath & fName, UpdateLinks:=xlUpdateLinksNever) 'open found file
For Each ws In wb.Worksheets
With ws.Cells
.SpecialCells(xlCellTypeBlanks).Locked = False
End With
With ws
.Protect Password:=pwd
End With
Next ws
wb.Close True                   'close/save
fName = Dir                     'get next filename
Loop
Application.ScreenUpdating = True
End Sub

我发现代码很有用，所以感谢大家的贡献