宏在文件夾保護所有非空白單元格的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 

參見循環