엑셀 추가기능 만들기

엑셀 VBA 코드를 사용하여 추가기능에 버튼을 넣어서 메크로를 실행해보자.

 

대충 아래 그림과 같아지네요......

 

 

[버튼 설명]

Top : 선택영역 중 맨 윗칸에 합계넣기 (단, sum명령어가 아닌 +로)

Bottom : 선택영역 중 맨 아랫칸에 합계넣기.

Trim : 문자열 Trim (숫자에 "," 앞뒤에 빈칸 지우기)

Picture : 선택 셀에 사진 넣기 (셀의 가로 세로에 맞게)

 

일단 빈 창을 열어 VBA를 실행.

 

모듀을 추가 하여 코드를 넣는다. AddNew

추가기능에서 사용되는 버튼을 만드는 코드임.

Sub AddNewCB()
'메뉴만들기
   Dim myCommandBar As CommandBar, myCommandBarCtl As CommandBarControl
   On Error GoTo AddNewCB_Err
  
   Set myCommandBar = CommandBars.Add(Name:="DAWOO Toolbar", Position:=msoBarFloating)
   myCommandBar.Visible = True
  
   Set myCommandBarCtl = myCommandBar.Controls.Add(Type:=msoControlButton) 'Top버튼 만들기
   With myCommandBarCtl
      .Caption = "Top"
      .Style = msoButtonCaption
      .OnAction = "Selected_Area_SUM_Top"
   End With
  
   Set myCommandBarCtl = myCommandBar.Controls.Add(Type:=msoControlButton) 'Bottom버튼 만들기
   With myCommandBarCtl
      .Caption = "Bottom"
      .Style = msoButtonCaption
      .OnAction = "Selected_Area_SUM_Bottom"
   End With
  
   Set myCommandBarCtl = myCommandBar.Controls.Add(Type:=msoControlButton) 'Trim버튼 만들기
   With myCommandBarCtl
      .Caption = "Trim"
      .Style = msoButtonCaption
      .OnAction = "trim_text"
   End With
  
   Set myCommandBarCtl = myCommandBar.Controls.Add(Type:=msoControlButton) 'Picture버튼 만글기
   With myCommandBarCtl
      .Caption = "Picture"
      .Style = msoButtonCaption
      .OnAction = "Picture_Insertion"
   End With
  
   Exit Sub
AddNewCB_Err:
   Debug.Print Err.Number & vbCr & Err.Description
   Exit Sub
End Sub

 

 

모듈을 추가 하여 코드를 넣는다. My_Module

버튼을 클릭시 실행되는 VB 코드임.

Sub Selected_Area_SUM_Top()
'선택 맨 위에 합계 넣기
    Dim C As Range, T As String
    For Each C In Selection
        If C.Address <> Selection.Cells(1).Address Then
            If Len(T) Then T = T & "+"
            T = T & C.Address(0, 0)
        End If
    Next
    Selection.Cells(1) = "=" & T
End Sub

 

Sub Selected_Area_SUM_Bottom()
'선택 맨 아래 합계 넣기
    Dim C As Range, T As String
    For Each C In Selection
        If C.Address <> Selection.Cells(Selection.Count).Address Then
            If Len(T) Then T = T & "+"
            T = T & C.Address(0, 0)
        End If
    Next
    Selection.Cells(Selection.Count) = "=" & T
End Sub

 

Sub trim_text()
'문자열 Trim 하기
Dim rngText As Range, i As Long
    On Error GoTo er
    Set rngText = Selection.SpecialCells(xlCellTypeConstants, 2)
    Select Case MsgBox("문자열을 Trim합니다. 문자열 뒷부분만 Trim할려면 아니오를 " _
      & "클릭하세요.", vbYesNoCancel)
      Case vbYes
        For i = 1 To rngText.Areas.Count
          rngText.Areas(i) = Application.Trim(rngText.Areas(i))
        Next i
      Case vbNo
        For i = 1 To rngText.Areas.Count
          rngText.Areas(i) = Application.Evaluate("IF(" & _
            rngText.Areas(i).Address & "=" & rngText.Areas(i).Address & _
            ",REPT("" "",FIND(LEFT(TRIM(" & rngText.Areas(i).Address & "),1)," & _
            rngText.Areas(i).Address & ")-1)&TRIM(" & rngText.Areas(i).Address & "))")
        Next i
    End Select
    Exit Sub
er:
    MsgBox "지정된 범위에 문자가 없습니다."
End Sub

 

Sub Picture_Insertion()
'사진 넣기
Dim p As Picture
Dim i As Integer
    i = ActiveSheet.Pictures.Count

    Application.Dialogs(xlDialogInsertPicture).Show
  
    If i = ActiveSheet.Pictures.Count Then
    Else
        Set p = ActiveSheet.Pictures(i + 1)
        With ActiveCell.MergeArea
            p.ShapeRange.LockAspectRatio = msoFalse ' 가로세로비율 마춤 해제
            p.Left = .Left + 0
            p.Top = .Top + 0
            p.Width = .Width - 0
            p.Height = .Height - 0
        End With
    End If
  
End Sub

Function AddColor(Rng, CRng)
'같은 색만 더하기
    For Each C In Rng

        If C.Font.ColorIndex = CRng.Font.ColorIndex Then S = S + C.Value

    Next

    AddColor = S

End Function

 

 

다른이름으로 저장

파일이름 : 적당히

파일형식 : Excel 97-2003 추가기능

 

추가기능 등록은 검색하면 나옴.

 

이렇게 하고, 엑셀을 다시 시작해도 메뉴가 않나온다. 나도 고생 중.......

 

VBA 코드 편집기에 가서

현재_통합_문서 더블클릭 후 아래 코드를 넣어줘야. 생깁니다.

 

Private Sub Workbook_Open()
 Call AddNewCB
End Sub

 

다시 저장 (VBA 에서 저장)

 

엑셀 닫고, 다시 열면 짜잔.........

 

 

그리고 하나더 팁.

addcolor 추가 하였습니다.

셀에서 =sum(영역선택) 을 하면 합계가 됩니다. 모두 아실내용.

셀에서 =addcolor(A1:A10,A1) 이렇게 하면 A1에 있는 글자색과 같은 것만 합을 구합니다.

 

 

MyExcelAddIN01.xlam