Phá Pass cho hàng loạt file cho nhanh (Pass do chính mình đặt ra) (1 người xem)

[Dauthivan]

Em hỏi trong trường hợp này Password do chính bản thân em đặt ra để bảo vệ bảng tính (Protect Sheet) tránh bị chỉnh sửa. Nay em muốn đổi Font chữ tất cả các file của em sang Unicode, vấn đề của em là làm thế nào cho nhanh.

Giả thiết bài toán của em áp dụng cho các file là:
- Các file được đặt Pass giống hệt nhau,
- Bản thân em nhớ Pass.

Em xin nhờ hỏi có Code này để tự động phá hết 1 loạt Pass không
(kể cả không cần mở file ra cũng được, cứ gom chung nó vào cùng thư mục nếu nó gặp file nào cùng Pass thì lập tức tự động gỡ bỏ).

 

[ndu96081631]

Em xin nhờ hỏi có Code này để tự động phá hết 1 loạt Pass không
(kể cả không cần mở file ra cũng được, cứ gom chung nó vào cùng thư mục nếu nó gặp file nào cùng Pass thì lập tức tự động gỡ bỏ).

Thử record macro quá trình:
- Mở file
- Bỏ Protect sheet
===> Xong, xem code viết gì rồi chỉnh lại

 

[Dauthivan]

Thử record macro quá trình:
- Mở file
- Bỏ Protect sheet
===> Xong, xem code viết gì rồi chỉnh lại

Tức là trong trường hợp này khi bỏ Pass ra thì nhất thiết phải mở từng file ra trước hả thày?

 

[ndu96081631]

Tức là trong trường hợp này khi bỏ Pass ra thì nhất thiết phải mở từng file ra trước hả thày?

Tạm thời là vậy vì tôi không biết có cách khác hoàn toàn không mở file hay không

 

[bimbim1412]

Tức là trong trường hợp này khi bỏ Pass ra thì nhất thiết phải mở từng file ra trước hả thày?

Thử dùng cái này xem

Option Explicit

Public Sub Protect_Sheets()
On Error Resume Next
Dim strPass As String
Dim sht_name As Worksheet
strPass = InputBox("Enter your Password")
For Each sht_name In Worksheets
    If Not sht_name.ProtectContents Then
        sht_name.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=strPass
    End If
Next sht_name
End Sub


Public Sub UnProtect_Sheets()
On Error Resume Next
Dim strPass As String
Dim sht_name As Worksheet
strPass = InputBox("Enter your Password")
For Each sht_name In Worksheets
    sht_name.Unprotect strPass
Next sht_name
End Sub


Public Sub Protect_Unprotect()
frmProtect.Show vbModal
End Sub

 

[ndu96081631]

Thử dùng cái này xem

Option Explicit

Public Sub Protect_Sheets()
On Error Resume Next
Dim strPass As String
Dim sht_name As Worksheet
strPass = InputBox("Enter your Password")
For Each sht_name In Worksheets
    If Not sht_name.ProtectContents Then
        sht_name.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=strPass
    End If
Next sht_name
End Sub


Public Sub UnProtect_Sheets()
On Error Resume Next
Dim strPass As String
Dim sht_name As Worksheet
strPass = InputBox("Enter your Password")
For Each sht_name In Worksheets
    sht_name.Unprotect strPass
Next sht_name
End Sub


Public Sub Protect_Unprotect()
frmProtect.Show vbModal
End Sub

Viết cái gì thế không biết???
Rồi lệnh mở file nằm ở chổ nào đâu?

 

[Quang_Hải]

Em hỏi trong trường hợp này Password do chính bản thân em đặt ra để bảo vệ bảng tính (Protect Sheet) tránh bị chỉnh sửa. Nay em muốn đổi Font chữ tất cả các file của em sang Unicode, vấn đề của em là làm thế nào cho nhanh.

Giả thiết bài toán của em áp dụng cho các file là:
- Các file được đặt Pass giống hệt nhau,
- Bản thân em nhớ Pass.

Em xin nhờ hỏi có Code này để tự động phá hết 1 loạt Pass không
(kể cả không cần mở file ra cũng được, cứ gom chung nó vào cùng thư mục nếu nó gặp file nào cùng Pass thì lập tức tự động gỡ bỏ).

Thử code này xem sao. Giả sử pass là 123456789

Sub Mo_Pass()
Dim FilesToOpen, sh As Worksheet
Dim X As Integer, pass
On Error GoTo ErrHandler
Application.ScreenUpdating = False
pass = 123456789
FilesToOpen = Application.GetOpenFilename _
      (filefilter:="Excel Files, *.xl*", MultiSelect:=True)
If TypeName(FilesToOpen) = "Boolean" Then
   MsgBox "No Files were selected"
   GoTo ExitHandler
End If
    X = 1
    While X <= UBound(FilesToOpen)
        Workbooks.Open Filename:=FilesToOpen(X)
        With ActiveWorkbook
            For Each sh In .Worksheets
               sh.Unprotect pass
            Next
        .Close True
        End With
        X = X + 1
    Wend
ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub