2018. 4. 10. 18:25

VBA를 이용하여 엑셀의 선택 셀에 대한 대소문자 변경

MS 사이트에 있는 코드 긁어와서 한글 설명만 붙임


Sub ToggleCaseMacro(),

    Dim CaseRange As Range,

    Dim CalcMode As Long,

    Dim cell As Range,

,

    On Error Resume Next,

    ' 선택한 영역(셀이 하나 이상일 수 있음!)에 Text셀이 존재하는지 여부를 검사하는 함수,

    ' 선택영역과 선택영역의 Text셀이 중복되면 해당 영역을 반환. 없으면 Nothing 처리,

    Set CaseRange = Intersect(Selection, _,

        Selection.Cells.SpecialCells(xlCellTypeConstants, xlTextValues)),

    ,

    ' 일단 Error 무시,

    On Error GoTo 0,

    If CaseRange Is Nothing Then Exit Sub,

,

    ' 화면 갱신을 막아줌,

    With Application,

        CalcMode = .Calculation,

        .Calculation = xlCalculationManual,

        .ScreenUpdating = False,

        .EnableEvents = False,

    End With,

,

    ,

    ' 셀이 하나 이상일 수 있으니 모든 셀에 대해서 대문자면 소문자로, 소문자면 적절하게 변경하고 그 외의 경우는 대문자 처리함,

    For Each cell In CaseRange.Cells,

        Select Case cell.Value,

        Case UCase(cell.Value): cell.Value = LCase(cell.Value),

        Case LCase(cell.Value): cell.Value = StrConv(cell.Value, vbProperCase),

        Case Else: cell.Value = UCase(cell.Value),

        End Select,

    Next cell,

,

    ,

    ' 화면 갱신을 다시 진행,

    ' 이렇게 해야 화면에 변화하는게 안보이고 한번에 변경된거 같으면서 속도도 빠름,

    ' 의외로 새로 그리기 속도가 꽤 느리기 때문에 위의 갱신 막는것과 함께 같이 항상 써줘야 함,

    With Application,

        .ScreenUpdating = True,

        .EnableEvents = True,

        .Calculation = CalcMode,

    End With,

End Sub


2018. 4. 10. 18:05

엑셀 Addin 작성시 마우스 오른쪽 메뉴 생성 방법

MS쪽 사이트에 있는 코드를 그대로 가져와 설명만 붙여봄


Sub AddToCellMenu(),

    Dim ContextMenu As CommandBar,

    Dim MySubMenu As CommandBarControl,

,

    ' 중복 제거를 위해서 미리 메뉴를 삭제해 줌,

    Call DeleteFromCellMenu,

,

    ' CommandBars("Cell")로 지정하면 ContextMenu를 접근할 수 있음,

    Set ContextMenu = Application.CommandBars("Cell"),

,

    ,

    ' 내장되어 있는 메뉴를 추가(ID = 3 -> Save),

    ' 내장되어 있는 메뉴를 추가하기 위해선 아래의 한줄이면 끝,

    ' before는 순서,

    ContextMenu.Controls.Add Type:=msoControlButton, ID:=3, before:=1,

,

,

    ' 1단짜리 메뉴 추가. 일반 툴바에 버튼 추가하는 것과 같은데 순서 지정하는 부분이 있음,

    ' OnAction에는 동작할 함수가, FaceId는 아이콘이, Caption의 경우 Text로 표시할 부분이, Tag에는 기타 정보가 들어감,

    ' 삭제시에 Tag정보를 바탕으로 버튼을 삭제할 수 있음,

    With ContextMenu.Controls.Add(Type:=msoControlButton, before:=2),

        .OnAction = "'" & ThisWorkbook.Name & "'!" & "ToggleCaseMacro",

        .FaceId = 59,

        .Caption = "대문자/소문자/적절한 문자로 전환",

        .Tag = "My_Cell_Control_Tag",

    End With,

,

    ' Add a custom submenu with three buttons.,

    ' 서브메뉴가 있는 경우 추가 방법,

    ' 일단 메뉴를 하나 만들고, 그 아래 버튼을 넣는 방식,

    ' 메뉴를 추가할때 Type을 보면 msoControlPopup임. 버튼일 경우는 Type이 msoControlButton임,

    ' 일단 버튼을 만든 이후에는 일반 메뉴와 똑같음,

    Set MySubMenu = ContextMenu.Controls.Add(Type:=msoControlPopup, before:=3),

,

    With MySubMenu,

        .Caption = "문자메뉴",

        .Tag = "My_Cell_Control_Tag",

,

        With .Controls.Add(Type:=msoControlButton),

            .OnAction = "'" & ThisWorkbook.Name & "'!" & "UpperMacro",

            .FaceId = 100,

            .Caption = "대문자",

        End With,

        With .Controls.Add(Type:=msoControlButton),

            .OnAction = "'" & ThisWorkbook.Name & "'!" & "LowerMacro",

            .FaceId = 91,

            .Caption = "소문자",

        End With,

        With .Controls.Add(Type:=msoControlButton),

            .OnAction = "'" & ThisWorkbook.Name & "'!" & "ProperMacro",

            .FaceId = 95,

            .Caption = "적절한문자",

        End With,

    End With,

,

    ' 아래 명령어로 중간 구분자를 넣을 수 있음,

    ContextMenu.Controls(4).BeginGroup = True,

End Sub,

,

Sub DeleteFromCellMenu(),

    Dim ContextMenu As CommandBar,

    Dim ctrl As CommandBarControl,

,

    ' CommandBars("Cell")로 지정하면 ContextMenu를 접근할 수 있음,

    Set ContextMenu = Application.CommandBars("Cell"),

,

    ' Delete the custom controls with the Tag : My_Cell_Control_Tag.,

    ' 모든 콘트롤들을 보면서 Tag가 My_Cell_Control_Tag 인 항목을 찾아서 지워줌,

    ' 이렇게 하면 원하는 모든 걸 한번에 지울 수 있으니 이 방법을 쓰면 좋을 것임,

    For Each ctrl In ContextMenu.Controls,

        If ctrl.Tag = "My_Cell_Control_Tag" Then,

            ctrl.Delete,

        End If,

    Next ctrl,

,

    ,

    On Error Resume Next,

    ' 내장 기능에 대한 삭제는 아래와 같은 방법으로 사용,

    ContextMenu.FindControl(ID:=3).Delete,

    On Error GoTo 0,

End Sub,


2011. 3. 25. 10:28

엑셀에서 탭(워크시트)들을 알파벳순으로 정렬하는 방법

엑셀에 별도로 그런 기능은 제공하지 않고,
MS쪽에 보니 VB매크로를 줘서 돌려보니까 잘 동작한다.

워크시트 아무데서나 alt-f11을 누르면 vb편집기가 나오고 거기 붙여 넣기 한담에 F5를 눌러서
돌리면 끝.

소스를 조금만 보면 오름차순/내림차순 변경도 가능할지도..

--- 아래부터가 소스

Sub Sort_Active_Book()
Dim i As Integer
Dim j As Integer
Dim iAnswer As VbMsgBoxResult
'
' Prompt the user as which direction they wish to
' sort the worksheets.
'
   iAnswer = MsgBox("Sort Sheets in Ascending Order?" & Chr(10) _
     & "Clicking No will sort in Descending Order", _
     vbYesNoCancel + vbQuestion + vbDefaultButton1, "Sort Worksheets")
   For i = 1 To Sheets.Count
      For j = 1 To Sheets.Count - 1
'
' If the answer is Yes, then sort in ascending order.
'
         If iAnswer = vbYes Then
            If UCase$(Sheets(j).Name) > UCase$(Sheets(j + 1).Name) Then
               Sheets(j).Move After:=Sheets(j + 1)
            End If
'
' If the answer is No, then sort in descending order.
'
         ElseIf iAnswer = vbNo Then
            If UCase$(Sheets(j).Name) < UCase$(Sheets(j + 1).Name) Then
               Sheets(j).Move After:=Sheets(j + 1)
            End If
         End If
      Next j
   Next i
End Sub