dirtybit의 외부기억장치

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

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,