[ 엑셀 VBA ] 간단한 파일 관리 및 분류 프로그램 만들기-두번째

지난 블로그에 이어서 작성되는 블로그입니다.

※ [ 엑셀 VBA ] 간단한 파일 관리 및 분류 프로그램 만들기-첫번째

 

 워크시트 더블 클릭 시 바로가기 및 실행 창 열기

 

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Target.row < 8 Then Exit Sub

    If Target.Column < 1 Or Target.Column > 7 Then Exit Sub

    If IsEmpty(Cells(Target.row, "A")) Then Exit Sub

    Cancel = True

    SelectedRow = Target.row

    UserForm2.Show
End Sub

 

더블클릭한 셀이 7행보다 작거나 

7열 즉, G열보다 오른쪽에 있는 열을 클릭하거나,

A열이 비어있는 셀을 선택하면 실행되지 않습니다.

 

그리고 UserForm2를 실행합니다.

 

반응형

 UserForm2의 기능

 

UserForm2는 다음과 같이 버튼 두 개로 구성되어 있습니다.

 

바로가기는 해당 파일이 있는 폴더를 여는 것이고

실행하기는 해당 파일을 바로 실행하는 것입니다.

 

두 버튼 모두 OpenFileorFolder() 라는 함수에

True 또는 False를 넘겨 실행됩니다.

True를 넘기면 바로가기가 실행되고

False를 넘기면 실행하기가 실행됩니다.

Private Sub OpenFileOrFolder(OpenFolderOnly As Boolean)
    Dim ws As Worksheet
    Dim filePath As String
    Dim folderPath As String

    Set ws = ThisWorkbook.ActiveSheet

    If SelectedRow < 8 Then
        MsgBox "유효하지 않은 행 번호입니다.", vbExclamation
        Exit Sub
    End If

    filePath = ws.Cells(SelectedRow, "G").Value

    If Trim(filePath) = "" Then
        MsgBox "파일 경로가 없습니다.", vbExclamation
        Exit Sub
    End If
    
    If OpenFolderOnly Then
        folderPath = Left(filePath, InStrRev(filePath, "\") - 1)

        If Dir(folderPath, vbDirectory) <> "" Then
            Shell "explorer.exe """ & folderPath & """", vbNormalFocus
        Else
            MsgBox "폴더를 찾을 수 없습니다: " & folderPath, vbExclamation
        End If
    Else
        If Dir(filePath) = "" Then
            MsgBox "파일을 찾을 수 없습니다:" & vbNewLine & filePath, vbExclamation
            Exit Sub
        End If

        On Error Resume Next
        CreateObject("Shell.Application").ShellExecute filePath, "", "", "open", 1
        
        If Err.Number <> 0 Then
            MsgBox "파일 실행 중 오류가 발생했습니다:" & vbNewLine & Err.Description, vbCritical
            Err.Clear
        End If
        On Error GoTo 0
        Unload Me
    End If
End Sub

 

별도의 버튼으로 하나의 셀 클릭 시 동작하도록 한 이유는

여러 개를 동시에 선택해서 실행했을 때

 

728x90

 행 삭제하기

 

불필요한 행을 삭제하기 위해 

먼저 마우스 우클릭 시 메뉴가 나타나도록 설정합니다.

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True

    With Application.CommandBars.Add(Position:=msoBarPopup, Temporary:=True)
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "선택한 행 삭제하기"
            .OnAction = "DeleteRows_Click"
        End With
        .ShowPopup
    End With
End Sub

 

선택한 행 삭제하기를 실행하면 DeleteRows_Click() 함수가 실행됩니다.

Public Sub DeleteRows_Click()
    Dim response As VbMsgBoxResult
    Dim ws As Worksheet
    Dim selectedRows As New Collection
    Dim cell As Range
    
    Set ws = ActiveSheet

    If Selection Is Nothing Then Exit Sub

    On Error Resume Next
    For Each cell In Selection.Cells
        selectedRows.Add cell.row, CStr(cell.row)
    Next cell
    On Error GoTo 0

    response = MsgBox("선택한 " & selectedRows.Count & "개의 행을 삭제하시겠습니까?", _
                     vbQuestion + vbYesNo, "행 삭제 확인")
    
    If response = vbYes Then

        If ws.ProtectContents Then
            ws.Unprotect
        End If
        
        Application.ScreenUpdating = False

        Dim i As Long
        For i = selectedRows.Count To 1 Step -1
            ws.Rows(selectedRows(i)).Delete
        Next i
        
        Application.ScreenUpdating = True

        ws.Protect Password:="" _
                 , UserInterfaceOnly:=True _
                 , AllowFiltering:=True _
                 , AllowSorting:=True
    End If
End Sub

 

 기타

 

파일을 불러와 B열의 셀에 데이터가 입력되면

A열에 ROW() 함수가 적용되게 만들어 연번 관리를 해줍니다.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column <> 2 Then Exit Sub

    If Me.ProtectContents Then
        Me.Unprotect
    End If
    
    Application.EnableEvents = False

    If Not IsEmpty(Target.Value) Then
        Me.Cells(Target.row, "A").Formula = "=ROW(A" & Target.row & ")-7"
    Else
        Me.Cells(Target.row, "A").ClearContents
    End If
    
    Application.EnableEvents = True

    Me.Protect Password:="" _
              , UserInterfaceOnly:=True _
              , AllowFiltering:=True _
              , AllowSorting:=True
End Sub

 

엑셀 파일이 열고 닫힐 때 자동으로 시트 보호 및 

필터 해제 및 적용을 합니다.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim ws As Worksheet
    Set ws = ThisWorkbook.ActiveSheet

    On Error Resume Next
    ws.Unprotect
    On Error GoTo 0

    If ws.AutoFilterMode Then
        ws.AutoFilterMode = False
    End If

    ws.Protect Password:="", _
             UserInterfaceOnly:=True, _
             AllowFiltering:=True, _
             AllowSorting:=True
End Sub

Private Sub Workbook_Open()
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Worksheets("Sheet1")

    On Error Resume Next
    ws.Unprotect
    On Error GoTo 0
    
    If ws.AutoFilterMode Then
        ws.AutoFilterMode = False
    End If
   
    ws.Range("A7:G7").AutoFilter

    ws.Range("A8:G1048576").Locked = True
    
    ws.Protect Password:="", _
              UserInterfaceOnly:=True, _
              AllowFiltering:=True, _
              AllowSorting:=True
End Sub

 

마지막으로 새로고침을 눌렀을 경우

Sheet3의 데이터를 기반으로 유형을 재분류합니다.

Sub RefreshTypeData()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRowTarget As Long
    Dim i As Long
    Dim fileExt As String
    Dim fileType As String
    Dim lookupRange As Range

    Set wsSource = ThisWorkbook.Worksheets("Sheet3")
    Set wsTarget = ThisWorkbook.Worksheets("Sheet1")

    Set lookupRange = wsSource.ListObjects("표2").Range

    lastRowTarget = wsTarget.Cells(wsTarget.Rows.Count, "E").End(xlUp).row

    For i = 8 To lastRowTarget
        fileExt = LCase(wsTarget.Cells(i, "E").Value)
        
        fileType = ""
        On Error Resume Next
        fileType = Application.WorksheetFunction.VLookup(fileExt, lookupRange, 2, False)
        If Err.Number <> 0 Then
            fileType = "Unknown"
            Err.Clear
        End If
        On Error GoTo 0
        
        wsTarget.Cells(i, "D").Value = fileType
    Next i
    
    MsgBox "유형 데이터가 갱신되었습니다.", vbInformation
End Sub

 

 마치며

 

개인적인 사용에 초점을 두다 보니

엑셀의 한 시트에서 수용할 수 있는 정도의 파일만 관리가 가능합니다.

파일관리.xlsm

0.04MB

여기를 방문하시면 더 많은 엑셀 관련 자료를 확인할 수 있습니다.

엑셀 공부하기
VBA 공부하기