엑셀 사용자, 날짜 보안 매크로 (엑셀 파일 보안 마스터 코드)

1️⃣ 보안 관련 - VBA 마스터 코드

Option Private Module
Public blnClose As Boolean

Function CloseWB(Optional SaveChanges As Boolean = True, Optional DisplayAlert As Boolean = False) As Boolean

'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ CloseWB, SecureSave 함수
'▶ 파일 보안을 위하여 파일 저장 및 종료 시 임시 로그아웃 처리하는 모듈입니다.
'▶ 인수 설명
'_____________SaveChanges : [선택인수] False일 경우 파일을 저장하지 않고 종료합니다. 기본값은 True 입니다.
'_____________DisplayAlret : [선택인수] True일 경우 파일 종료 전 알림메시지를 출력합니다. 기본값은 False 입니다.
'▶ 사용방법
'로그아웃 시 실행할 동작을 Logout에 작성합니다. (예: 시트 숨기기 등..)
'
'▶현재_통합_문서 모듈에 아래 명령문을 복사/붙여넣기 합니다.
'Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Cancel = CloseWB(, True)
'End Sub
'Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'SecureSave
'Cancel = True
'End Sub
'##############################################################

Dim WB As Workbook
Dim i As Long
Dim vbYN As VbMsgBoxResult
 
Application.DisplayAlerts = False
 
Logout
 
If blnClose = False Then
 
    If DisplayAlert = True Then
 
        vbYN = MsgBox("'" & ThisWorkbook.Name & "' 의 변경내용을 저장하시겠습니까?", vbYesNoCancel)
 
        If vbYN = vbNo Then SaveChanges = False: blnClose = True
        If vbYN = vbYes Then SaveChanges = True: blnClose = True
        If vbYN = vbCancel Then blnClose = False: GoTo Finally
 
    End If
 
    For Each WB In Application.Workbooks
        If WB.Name <> "PERSONAL.XLSB" Then i = i + 1
    Next
 
    If i = 1 Then
        If SaveChanges = True Then
            ThisWorkbook.Save
            Application.EnableEvents = False
            Application.Quit
        Else
            ThisWorkbook.Saved = True
            Application.EnableEvents = False
            Application.Quit
        End If
    Else
        If SaveChanges = True Then
            ThisWorkbook.Save
            ThisWorkbook.Close
        Else
            ThisWorkbook.Saved = True
            ThisWorkbook.Close
        End If
    End If
 
End If
 
CloseWB = False
Application.DisplayAlerts = True
 
Exit Function
 
Finally:
Application.DisplayAlerts = True
CloseWB = True
 
End Function

Sub SecureSave()

Dim DictWS As Object
Dim WS As Worksheet
Dim sName As String

Application.ScreenUpdating = False
Application.EnableEvents = False

Set DictWS = CreateObject("Scripting.Dictionary")
sName = ActiveSheet.Name

For Each WS In ThisWorkbook.Worksheets
    DictWS.Add WS.Name, WS.Visible
Next

Logout

ThisWorkbook.Save
ThisWorkbook.Saved = True

For Each WS In ThisWorkbook.Worksheets
    WS.Visible = DictWS(WS.Name)
Next
Worksheets(sName).Activate

Application.EnableEvents = True
Application.ScreenUpdating = True


End Sub

Sub Logout()
 
'로그아웃 실행 동작
 
End Sub

2️⃣ 이번 강의에서 사용된 보조 매크로 모듈

Sub HideSheets(Optional Exclude As Variant)

'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ HideSheets 함수
'▶ 사용중인 통합문서의 시트를 완전히 숨깁니다.
'    Exclude 가 누락될 경우 통합문서의 첫번째 시트가 숨기기에서 제외됩니다.
'▶ 인수 설명
'_____________Exclude : [선택인수] 제외할 시트 이름을 입력합니다. 쉼표(,)로 구분하여 여러 시트를 입력할 수 있습니다.
'##############################################################

Dim WS As Worksheet
Dim vArr As Variant: Dim v As Variant
Dim Dict As Object
Set Dict = CreateObject("Scripting.Dictionary")

If Not IsMissing(Exclude) Then
    vArr = Split(Exclude, ",")
    For Each v In vArr
        Dict.Add Trim(v), ""
    Next
Else
    Dict.Add ThisWorkbook.Worksheets(1).Name, ""
End If

On Error Resume Next
For Each WS In ThisWorkbook.Worksheets
    If Dict.exists(WS.Name) = True Then
        WS.Visible = xlSheetVisible
    Else
        WS.Visible = xlSheetVeryHidden
    End If
Next

End Sub

Sub UnHideSheets(Optional Exclude As Variant)

'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ UnHideSheets 함수
'▶ 사용중인 통합문서의 시트를 숨기기취소합니다.
'    Exclude가 누락될 경우 모든 시트를 숨기기 취소 합니다.
'▶ 인수 설명
'_____________Exclude : [선택인수] 제외할 시트 이름을 입력합니다. 쉼표(,)로 구분하여 여러 시트를 입력할 수 있습니다.
'##############################################################

Dim WS As Worksheet
Dim vArr As Variant: Dim v As Variant
Dim Dict As Object
Dim i As Long: Dim j As Long: Dim x As Long: x = 1
Set Dict = CreateObject("Scripting.Dictionary")

If Not IsMissing(Exclude) Then
    vArr = Split(Exclude, ",")
    For Each v In vArr
        Dict.Add Trim(v), ""
    Next
End If

On Error GoTo EH:

Retry:

For i = x To ThisWorkbook.Worksheets.Count
    If Dict.exists(ThisWorkbook.Worksheets(i).Name) = True Then
        ThisWorkbook.Worksheets(i).Visible = xlSheetVeryHidden
    Else
        ThisWorkbook.Worksheets(i).Visible = xlSheetVisible
        If j = 0 Then j = i
    End If
Next
If x = 2 Then ThisWorkbook.Worksheets(1).Visible = xlSheetVeryHidden
ThisWorkbook.Worksheets(j).Select

Exit Sub

EH:
x = 2
Resume Retry:

End Sub

Function GetSerialNumber(Optional ReturnType As Long = 2, Optional sHost As String = ".") As String

'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ GetSerialNumber 함수
'▶ 사용중인 PC의 바이오스/하드드라이브의 시리얼번호를 반환합니다. 고유 PC를 구분할 때 사용할 수 있습빈다.
'▶ 인수 설명
'_____________ReturnType    : 기본값은 하드드라이브의 시리얼번호를 반환합니다. 0은 바이오스와 하드 드라이브 모두, 1은 바이오스의 시리얼번호를 반환합니다.
'_____________sHost         : 기본값은 PC(로컬호스트)의 시리얼번호를 반환합니다. 네트워크주소를 입력해서 특정 네트워크PC의 속성을 받아올 수 있습니다.
'▶ win32-bios 설명 링크
'https://docs.microsoft.com/en-us/windows/desktop/cimwin32prov/win32-bios
'본 함수는 아래 원문 코드를 참고하여 작성되었습니다.
'https://www.devhut.net/2019/08/08/vba-determine-the-bios-serial-number/
'##############################################################

On Error GoTo EH:
Dim WMI As Object
Dim BiosList As Object: Dim BIOS As Object
Dim HDList As Object: Dim HD As Object
Dim strResult As String

Set WMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sHost & "\root\cimv2")
Set BiosList = WMI.ExecQuery("SELECT SerialNumber FROM Win32_BIOS")
Set HDList = WMI.ExecQuery("SELECT SerialNumber FROM Win32_DiskDrive")

If ReturnType = 0 Or ReturnType = 1 Then
    For Each BIOS In BiosList
        strResult = Trim(BIOS.SerialNumber) & "|"
        Exit For
    Next
    GetSerialNumber = Left(strResult, Len(strResult) - 1)
End If

If ReturnType = 0 Or ReturnType = 2 Then
    For Each HD In HDList
        strResult = Trim(HD.SerialNumber) & "|"
        Exit For
    Next
    If ReturnType = 0 Then
        GetSerialNumber = GetSerialNumber & "+" & Replace(Left(strResult, Len(strResult) - 1), ".", "")
    Else
        GetSerialNumber = Replace(Left(strResult, Len(strResult) - 1), ".", "")
    End If
End If

Set HD = Nothing
Set BIOS = Nothing
Set HDList = Nothing
Set BiosList = Nothing
Set WMI = Nothing
    
Exit Function
    
EH:
GetSerialNumber = 0

End Function

Sub DeleteWB(Optional WB As Workbook)

'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ DeleteWorkBook 함수
'▶ 통합문서를 완전히 삭제합니다.
'   WB가 누락될 경우 현재 활성화된 통합문서를 삭제합니다.
'   ★ 하드디스크에서 완전히 제거되므로 반드시 사본을 생성한 뒤 명령문을 실행합니다.
'▶ 인수 설명
'_____________WB : [선택인수] 완전히 삭제할 통합문서입니다.
'##############################################################

If WB Is Nothing Then Set WB = ActiveWorkbook

Application.EnableEvents = False
Application.DisplayAlerts = False

With WB
    If Len(Dir(.FullName)) Then
        .Saved = True
        On Error Resume Next
        .ChangeFileAccess Mode:=xlReadOnly
        If Application.Workbooks.Count = 1 Then Application.Quit
        On Error GoTo 0
        SetAttr Pathname:=.FullName, Attributes:=vbNormal
        Kill .FullName
        .Close SaveChanges:=False
    End If
End With

Application.EnableEvents = True
Application.DisplayAlerts = True
  
End Sub