楼主
little-key |
- '设置工作簿打开权限
- Sub shezhigongzuobodakaquanxian()
- On Error Resume Next
- With ActiveWorkbook
- 'If Not .Saved Then
- PSW = "xiao"
- If Len(.path) = 0 Then
- ans = MsgBox("此功能需要先保存后方可生效，" & Chr(13) & "但当前工作簿尚未做保存，" & vbCrLf & "您是否需要继续操作？", 64 + 4, "温馨提示:")
- If ans = 6 Then
- .Password = PSW '打开权限密码以及只读密码 Password:=1, WriteresPassword:=1
- aa = Application.Dialogs(xlDialogSaveAs).Show(.FullName, 12) '52为保存默认值为2007格式的可启用宏格式
- GoTo jingshi
- Exit Sub
- Else
- Exit Sub
- GoTo jingshi
- End If
- Else
- If Not .Saved Then
- .Password = PSW
- .Save
- GoTo jingshi
- Exit Sub
- Else
- MsgBox "当前工作簿未作任何改变！", 64, " 温馨提示:"
- Exit Sub
- End If
- End If
- End With
- jingshi:
- MsgBox "操作完毕！", 64, " 温馨提示:"
- End Sub
- '打开有打开权限密码的工作簿
- Sub liangcaiOpenPSW()
- 'On Error Resume Next
- On Error GoTo ErrorHandler
- PWS = "xiao"
- Filenames = Application.GetOpenFilename("所有文件 (*.*),*.*,Excel 文件 (*.xl*),*.xl*,加载宏文件 (*.xla),*.xla,文本文件 (*.txt),*.txt", 2, "选择文件", , False)
- If Filenames = False Then
- Exit Sub
- Else
- pd = Split(Filenames, ".")(1)
- If pd Like "xl*" Then
- Workbooks.Open FileName:=Filenames, Password:=PWS '如果有读写密码，则增加", WriteresPassword:=1"
- Exit Sub
- Else
- MsgBox "此文件不是Excel 文件，请核实！", 48 + vbOKOnly, "警示！"
- Exit Sub
- End If
- End If
- ErrorHandler:
- aa = MsgBox("密码错误，是否需要手动输入？", 48 + vbYesNo, "警示！")
- If aa = vbYes Then
- Workbooks.Open FileName:=Filenames
- Else
- Exit Sub
- End If
- End Sub
其中：
aa = Application.Dialogs(xlDialogSaveAs).Show(.FullName, 12)
中的12所在的位置代表另存为的格式，其中12表示另存为2007的普通格式。 |