:::맑은하늘 블로그:::

코드접기

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

코드접기

코드접기

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

코드접기