abyul.com > Excel > Question & Answer

엑셀에 대해서 궁금한 것이 있으시면 마음껏 질문해주세요.

이 게시판은 아별닷컴 회원만 질문을 올릴 수 있습니다. 회원에게 주어지는 특권인셈이지요. 회원이 아닌 분들은 열람만 가능합니다.

2012.06.18 14:06

쟈니님.. 안녕하세요?
현재 엑셀의 기본 기능에는 일괄 암호 설정 및 해제 방법이 없는 것으로 알고 있습니다.
추가기능으로 개발된 것도 발견하지 못했네요..(사실 안 찾아봤습니다. ㅋ)

그래서 제가 간단하게 만들어봤습니다.

첨부파일을 다운 받아 엑셀로 열고
버튼을 클릭하면 파일들을 선택해서 일괄 암호를 설정할 수 있습니다.

일괄 해제할 수 있는 기능도 추가했습니다.

도움이 되셨기를..

다운받기 : abyul.com_20120618_SetOrRemovePassword.xlsm

abyul.com_0000493-1.jpg

아래 코드도 참고하세요..

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