Sub setPassword() With Application.FileDialog(msoFileDialogFilePicker) .Filters.Add "Excel 파일", "*.xls; *.xlsx; *.csv", 1 .InitialFileName = "*.xls*" .Title = "Select Files to set password.. " & vbNewLine & _ "암호를 설정할 파일을 모두 선택하세요.. abyul.com" If .Show = vbTrue Then
Dim strPW As String strPW = InputBox("선택한 파일을 모두 " & _ "한가지 암호로 설정합니다." & vbNewLine & _ "사용할 암호를 입력하세요")
Dim lngCount As Long Dim wb As Workbook For lngCount = 1 To .SelectedItems.Count Set wb = Workbooks.Open(Filename:=.SelectedItems(lngCount)) wb.Password = strPW wb.Save wb.Close Next lngCount
Dim lngCount As Long Dim wb As Workbook For lngCount = 1 To .SelectedItems.Count Set wb = Workbooks.Open(Filename:=.SelectedItems(lngCount), Password:=strPW) wb.Password = "" wb.Save wb.Close Next lngCount
쟈니님.. 안녕하세요?
현재 엑셀의 기본 기능에는 일괄 암호 설정 및 해제 방법이 없는 것으로 알고 있습니다.
추가기능으로 개발된 것도 발견하지 못했네요..(사실 안 찾아봤습니다. ㅋ)
그래서 제가 간단하게 만들어봤습니다.
첨부파일을 다운 받아 엑셀로 열고
버튼을 클릭하면 파일들을 선택해서 일괄 암호를 설정할 수 있습니다.
일괄 해제할 수 있는 기능도 추가했습니다.
도움이 되셨기를..
다운받기 : abyul.com_20120618_SetOrRemovePassword.xlsm
아래 코드도 참고하세요..
Option Explicit
Sub setPassword()
With Application.FileDialog(msoFileDialogFilePicker)
.Filters.Add "Excel 파일", "*.xls; *.xlsx; *.csv", 1
.InitialFileName = "*.xls*"
.Title = "Select Files to set password.. " & vbNewLine & _
"암호를 설정할 파일을 모두 선택하세요.. abyul.com"
If .Show = vbTrue Then
Dim strPW As String
strPW = InputBox("선택한 파일을 모두 " & _
"한가지 암호로 설정합니다." & vbNewLine & _
"사용할 암호를 입력하세요")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim lngCount As Long
Dim wb As Workbook
For lngCount = 1 To .SelectedItems.Count
Set wb = Workbooks.Open(Filename:=.SelectedItems(lngCount))
wb.Password = strPW
wb.Save
wb.Close
Next lngCount
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End If
End With
End Sub
Sub removePassword()
With Application.FileDialog(msoFileDialogFilePicker)
.Filters.Add "Excel 파일", "*.xls; *.xlsx; *.csv", 1
.InitialFileName = "*.xls*"
.Title = "Select Files to remove password.. " & vbNewLine & _
"암호를 제거할 파일을 모두 선택하세요.. abyul.com"
If .Show = vbTrue Then
Dim strPW As String
strPW = InputBox("선택한 파일의 암호를 " & _
"모두 제거합니다." & vbNewLine & _
"기존에 설정된 암호를 입력하세요")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim lngCount As Long
Dim wb As Workbook
For lngCount = 1 To .SelectedItems.Count
Set wb = Workbooks.Open(Filename:=.SelectedItems(lngCount), Password:=strPW)
wb.Password = ""
wb.Save
wb.Close
Next lngCount
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End If
End With
End Sub