宏在文件夹保护所有非空白单元格的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 Settings\TRSECCAN\2011\Excel\" '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 

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

上面的代码只对活动的sheett执行此操作，我怎样才能使它为宏打开的所有表格？并有反正我可以提前部署下方到代码

UpdateLinks:=xlUpdateLinksNever 

感谢

Answer 1

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 Settings\TRSECCAN\2011\Excel\" '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 

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

这里是你的代码应该是什么样子（你应该删除不必要的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 Settings\TRSECCAN\2011\Excel\" '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 

参见循环