dirtybit의 외부기억장치

엑셀에서 Addin을 작성할때, 엑셀의 툴바 및 툴바 버튼, 메뉴를 추가하기 위한 코드
- 모든 작업은 ThisWorkbook 개체에서 작업한다.
- 되도록이면 작업하기 전에 On Error Resume Next 를 걸어줘서 오류를 없애는 편이 나을 것임

- Workbook_AddinInstall 이벤트에 아래와 같은 코드 추가
    ' 툴바에 버튼 올리기
    Application.CommandBars.Add "툴바이름"
    Application.CommandBars("툴바이름").Visible = True
    Set btnCmd = Application.CommandBars("툴바이름").Controls.Add(msoControlButton)
    btnCmd.OnAction = "클릭시 실행할 모듈 상의 함수이름1"
    btnCmd.Caption = "버튼이름1"
    btnCmd.FaceId = 64   ' 버튼 아이콘
    btnCmd.Style = msoButtonIcon  ' 버튼 모양
    Set btnCmd = Nothing
   
    Set btnCmd = Application.CommandBars("툴바이름").Controls.Add(msoControlButton)
    btnCmd.OnAction = "클릭시 실행할 모듈 상의 함수이름2"
    btnCmd.Caption = "버튼이름2"
    btnCmd.FaceId = 104   ' 버튼 아이콘
    btnCmd.Style = msoButtonIcon  ' 버튼 모양
    Set btnCmd = Nothing

    ' 메뉴에 삽입하기
    Set cmdBar = Application.CommandBars("worksheet menu bar")
    With cmdBar.Controls.Add(Type:=msoControlPopup)
        .Caption = "상위메뉴이름"
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "메뉴항목이름1"
            .OnAction = "메뉴항목클릭시 실행할 모듈상의 함수 이름1"
            .BeginGroup = True   ' 새로운 가로선을 넣을지 여부
            .FaceId = 64             ' 메뉴상에 표시할 아이콘 번호
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "메뉴항목이름2"
            .OnAction = "메뉴항목클릭시 실행할 모듈상의 함수 이름2"
            .FaceId = 301
        End With
    End With
    Set cmdBar = Nothing


- 툴바 삭제시 Workbook_AddinUninstall 이벤트에 아래와 같은 코드 추가
    ' 툴바 삭제
    Dim cmdBar As CommandBar
   Application.CommandBars("툴바이름").Visible = False   ' 툴바이름은 위에서 생성한 툴바 이름임
   Application.CommandBars("툴바이름").Delete

   ' 메뉴 삭제
    Set cmdBar = Application.CommandBars("worksheet menu bar")
    cmdBar.Controls("상위메뉴이름").Delete
    Set cmdBar = Nothing

- 오피스 2016에서 돌려보니 가끔 오류도 나오고 오류는 안나는데 추가기능 쪽의 메뉴가 나오지 않는 현상이 발생하는 경우가 있음. 이때에는 Addin이 Open 될 때 메뉴를 추가해주고 BeforeClose 일때 메뉴를 삭제해주는 방법을 사용한다.

이 때, 화면에 메뉴가 두개씩 나오는 나오는 경우가 발생할 수 있기 때문에 Workbook_AddinInstall 함수에서 기존 버튼이 있는지 확인하는 과정이 필요하다

Private Sub Workbook_AddinInstall()
    ' 이거 추가한다고 엑셀 열때마다 오류가 나면 짜증나니 이렇게 호출
    On Error Resume Next
    ' 기존에 해당 버튼이 있는지 확인
    If Application.CommandBars("버튼명") Is Nothing Then
        Application.CommandBars.Add "버튼명"
        Application.CommandBars("버튼명").Visible = True
        Set btnCmd = Application.CommandBars("버튼명").Controls.Add(msoControlButton)
        btnCmd.OnAction = "호출함수"
        btnCmd.Caption = "버튼명"
        btnCmd.FaceId = 1394   ' 버튼 아이콘
        btnCmd.Style = msoButtonIcon  ' 버튼 모양
        Set btnCmd = Nothing
    End If
	
End Sub

' 열릴 때 마다 툴바가 추가되면, 지속적으로 버튼만 늘어나기 때문에
' (install 할 때 기존에 버튼이 있는지 확인하기 때문에 그럴 리는 없지만 보험용도)
' 닫을 때 툴바를 없애줌(MS에서 이렇게 하라고 하였음)
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Workbook_AddinUninstall
End Sub

' 툴바가 자동으로 추가가 안되기 때문에 열릴때 마다 추가
Private Sub Workbook_Open()
    Workbook_AddinInstall
End Sub

지정한 드라이브의 하위포함 폴더 이름을 표시해 주는 엑셀 함수
폴더가 한단계씩 내려갈 수록 컬럼도 한칸씩 들어가도록 되어 있음
인터넷에서 찾은 VB소스를 엑셀에 맞게 조금 수정해서 사용하였음
엑셀 모듈에서 아래의 코드를 복사한 이후 직접 실행에서

FindFiles "C:\","A",1

같은 방법으로 실행하면 됨

'start_dir : 찾기 시작할 경로
' strStartCal : 기록을 시작할 컬럼명
' iStartRow : 기록을 시작할 ROW 번호
Function FindFiles(ByVal start_dir As String, ByVal strStartCal As String, ByVal iStartRow As Integer) As Integer
 Dim dirs() As String
 Dim dir_names() As String
 Dim num_dirs As Long
 Dim sub_dir As String
 Dim sub_name As String
 Dim file_name As String
 Dim i As Integer

 DoEvents
  
 sub_dir = Dir$(start_dir & "*", vbDirectory)
 Do While Len(sub_dir) > 0
     If UCase$(sub_dir) <> "PAGEFILE.SYS" And sub_dir <> "." And sub_dir <> ".." Then
  sub_name = sub_dir
  sub_dir = start_dir & sub_dir
  If GetAttr(sub_dir) And vbDirectory Then
      num_dirs = num_dirs + 1
      ReDim Preserve dirs(1 To num_dirs)
      ReDim Preserve dir_names(1 To num_dirs)
      dirs(num_dirs) = sub_dir & "\"
      dir_names(num_dirs) = sub_name
  End If
     End If

     sub_dir = Dir$(, vbDirectory)
 Loop

        '각각의 폴더에 대해 파일 찾기/재귀 호출
        For i = 1 To num_dirs
            Range(strStartCal + CStr(iStartRow)).FormulaR1C1 = dir_names(i)
            iStartRow = iStartRow + 1
            iStartRow = FindFiles(dirs(i), Chr(Asc(strStartCal) + 1), iStartRow)
            DoEvents
        Next i
 '결과 반환
 FindFiles = iStartRow
End Function