2018.04.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


Trackback 0 Comment 0
2018.04.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,


Trackback 0 Comment 0
2011.03.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
Trackback 0 Comment 1
2008.06.11 10:10

지정한 폴더들의 이름 목록을 표시하는 엑셀 함수

지정한 드라이브의 하위포함 폴더 이름을 표시해 주는 엑셀 함수
폴더가 한단계씩 내려갈 수록 컬럼도 한칸씩 들어가도록 되어 있음
인터넷에서 찾은 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

Trackback 0 Comment 0
2008.05.07 12:02

엑셀 Addin 작성시 툴바 및 메뉴 생성 / 제거 코드

엑셀에서 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

Trackback 0 Comment 0