워드_워드에서 한글 단축키 사용(매크로)

출처: https://wordtips.tistory.com/

ㅁ 사용 대상: 공문서, 논문 많이 쓰시는 분들께 추천

ㅁ 한글과 동일하게 사용할 수 있는 단축키

   - 빠른내어쓰기(ctrl+shift+tab)
   - 자간넓히기(shift+alt+w)
   - 자간좁히기(shift+alt+n)
   - 장평넓히기(shift+alt+k)
   - 장평좁히기(shift+alt+j)
   - 줄간격넓히기(shift+alt+z)
   - 줄간견좁히기(shift+alt+a)

ㅁ 매크로 

Option Explicit

' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 파일명   : hwpShortcuts.txt
' 버전     : v1.2
' 사용방법 : https://wordtips.tistory.com/entry/워드-한글-단축키-매크로-1-기능-소개-설정-방법
' 코드설명 : https://wordtips.tistory.com/entry/워드-한글-단축키-매크로-2-스크립트-코드-설명
' 참고사항 : [PREFIX] pt = point, ln = multiple-lines, pct = percent
' 변경기록 : 2020.08.05 최초 배포
'            2020.12.16 [빠른내어쓰기] 단락탭 설정을 SetCustomTabs로 분리
'            2020.12.16 [DisplayErrorMessage] 오류메시지 출력기능 추가
'
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub 한글단축키설정()
    
    ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' ''                                                               ''
    ' ''    여기를 클릭한 후 F5를 누르면 매크로 단축키가 설정됩니다.   ''
    ' ''                                                               ''
    ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    CustomizationContext = NormalTemplate
    
    KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyControl, wdKeyShift, wdKeyTab), KeyCategory:=wdKeyCategoryMacro, Command:="빠른내어쓰기"
    KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyShift, wdKeyAlt, wdKeyW), KeyCategory:=wdKeyCategoryMacro, Command:="자간넓히기"
    KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyShift, wdKeyAlt, wdKeyN), KeyCategory:=wdKeyCategoryMacro, Command:="자간좁히기"
    KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyShift, wdKeyAlt, wdKeyK), KeyCategory:=wdKeyCategoryMacro, Command:="장평넓히기"
    KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyShift, wdKeyAlt, wdKeyJ), KeyCategory:=wdKeyCategoryMacro, Command:="장평좁히기"
    KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyShift, wdKeyAlt, wdKeyZ), KeyCategory:=wdKeyCategoryMacro, Command:="줄간격넓히기"
    KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyShift, wdKeyAlt, wdKeyA), KeyCategory:=wdKeyCategoryMacro, Command:="줄간격좁히기"
    
    MsgBox ("단축키가 설정되었습니다")
    
End Sub

Sub 한글단축키해제()

    ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' ''                                                               ''
    ' ''    여기를 클릭한 후 F5를 누르면 매크로 단축키가 해제됩니다.   ''
    ' ''                                                               ''
    ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    CustomizationContext = NormalTemplate
    
    FindKey(KeyCode:=BuildKeyCode(wdKeyControl, wdKeyShift, wdKeyTab)).Clear
    FindKey(KeyCode:=BuildKeyCode(wdKeyShift, wdKeyAlt, wdKeyW)).Clear
    FindKey(KeyCode:=BuildKeyCode(wdKeyShift, wdKeyAlt, wdKeyN)).Clear
    FindKey(KeyCode:=BuildKeyCode(wdKeyShift, wdKeyAlt, wdKeyK)).Clear
    FindKey(KeyCode:=BuildKeyCode(wdKeyShift, wdKeyAlt, wdKeyJ)).Clear
    FindKey(KeyCode:=BuildKeyCode(wdKeyShift, wdKeyAlt, wdKeyZ)).Clear
    FindKey(KeyCode:=BuildKeyCode(wdKeyShift, wdKeyAlt, wdKeyA)).Clear
    
    MsgBox ("단축키가 해제되었습니다")
      
End Sub

Sub 빠른내어쓰기()

    Dim ptCursorPostion, ptLeftIndent, ptFirstLineIndent As Single
           
    Dim objUndo As UndoRecord
    Set objUndo = Application.UndoRecord
    
    On Error GoTo ErrorHandler
    
    If Selection.Type <> wdSelectionIP Then Exit Sub
         
    objUndo.StartCustomRecord ("빠른 내어쓰기")
    
    ptCursorPostion = Selection.Information(wdHorizontalPositionRelativeToTextBoundary)
    ptLeftIndent = Selection.ParagraphFormat.LeftIndent
    ptFirstLineIndent = Selection.ParagraphFormat.FirstLineIndent
    
    ' 단락 탭(CustomTab) 설정을 원하지 않으면 아래 줄 앞에 홑따옴표(')를 붙여 주석처리하세요.
    Call SetCustomTabs(ptCursorPostion:=ptCursorPostion, ptLeftIndent:=ptLeftIndent)
      
    With Selection.ParagraphFormat
        .CharacterUnitLeftIndent = 0
        .CharacterUnitFirstLineIndent = 0
        .LeftIndent = ptCursorPostion
        .FirstLineIndent = ptFirstLineIndent - (ptCursorPostion - ptLeftIndent)
    End With
    
    objUndo.EndCustomRecord
    
    Exit Sub
    
ErrorHandler:
    ActiveDocument.Undo
    objUndo.EndCustomRecord
    Call DisplayErrorMessage
    Exit Sub

End Sub

Private Sub SetCustomTabs(ByVal ptCursorPostion As Single, ByVal ptLeftIndent As Single)

    Dim ptCharacterPosition As Single
    Dim i, iCharactersBeforeCursor As Integer
    Dim ptTab As Variant
    Dim rng As Range
    Dim aTab As tabstop
    
    Dim ptAddedTabs, ptCustomTabs As Collection
    Set ptCustomTabs = New Collection
    Set ptAddedTabs = New Collection

    On Error GoTo ErrorHandler

    Set rng = Selection.Range
    rng.StartOf unit:=wdParagraph, Extend:=wdExtend
    iCharactersBeforeCursor = rng.Characters.Count
    
    For Each aTab In Selection.ParagraphFormat.TabStops
        If aTab.customTab Then
            ptCustomTabs.Add aTab.Position
        End If
    Next aTab
    
    With Selection.Paragraphs(1).Range
        For i = 1 To iCharactersBeforeCursor
            ptCharacterPosition = .Characters(i + 1).Information(wdHorizontalPositionRelativeToTextBoundary)
            If ptCharacterPosition >= ptCursorPostion Then
                Exit For
            End If
            If (Asc(.Characters(i)) = 9) And Not IsInCollection(ptCustomTabs, ptCharacterPosition) Then
                ptAddedTabs.Add ptCharacterPosition
            End If
        Next i
    End With
    
    For Each ptTab In ptAddedTabs
        Selection.ParagraphFormat.TabStops.Add Position:=ptTab, Alignment:=wdAlignTabLeft, _
                                               Leader:=wdTabLeaderSpaces
    Next ptTab
        
    If Selection.Range.ListFormat.ListType <> wdListNoNumbering Then
        Selection.ParagraphFormat.TabStops.Add Position:=ptLeftIndent, Alignment:=wdAlignTabLeft, _
                                               Leader:=wdTabLeaderSpaces
    End If

ErrorHandler:
    Call DisplayErrorMessage
    Exit Sub

End Sub

Private Function IsInCollection(objCollection As Collection, vValue As Variant) As Boolean

    Dim vItem As Variant
    
    IsInCollection = False
    
    On Error Resume Next
    
    For Each vItem In objCollection
        If vItem = vValue Then
            IsInCollection = True
            Exit Function
        End If
    Next vItem
    
End Function

Sub 장평좁히기()

    Dim objUndo As UndoRecord
    Set objUndo = Application.UndoRecord
    
    On Error GoTo ErrorHandler
    
    objUndo.StartCustomRecord ("장평 좁히기")
    
    Call SetTextScale(pctScaleChanged:=-1)
    
    objUndo.EndCustomRecord
    
    Exit Sub
    
ErrorHandler:
    ActiveDocument.Undo
    objUndo.EndCustomRecord
    Call DisplayErrorMessage
    Exit Sub

End Sub

Sub 장평넓히기()

    Dim objUndo As UndoRecord
    Set objUndo = Application.UndoRecord
    
    On Error GoTo ErrorHandler
    
    objUndo.StartCustomRecord ("장평 넓히기")
    
    Call SetTextScale(pctScaleChanged:=1)
    
    objUndo.EndCustomRecord
    
    Exit Sub
    
ErrorHandler:
    ActiveDocument.Undo
    objUndo.EndCustomRecord
    Call DisplayErrorMessage
    Exit Sub

End Sub

Private Sub SetTextScale(ByVal pctScaleChanged As Integer)

    Dim aCharacter As Range
    
    On Error GoTo ErrorHandler
    
    For Each aCharacter In Selection.Characters
        aCharacter.Font.Scaling = aCharacter.Font.Scaling + pctScaleChanged
    Next aCharacter
    
    Exit Sub

ErrorHandler:
    Call DisplayErrorMessage
    Exit Sub

End Sub

Sub 자간넓히기()

    Dim objUndo As UndoRecord
    Set objUndo = Application.UndoRecord
    
    On Error GoTo ErrorHandler
    
    objUndo.StartCustomRecord ("자간 넓히기")
    
    Call SetTextSpacing(ptSpacingChanged:=0.1)
    
    objUndo.EndCustomRecord
    
    Exit Sub
    
ErrorHandler:
    ActiveDocument.Undo
    objUndo.EndCustomRecord
    Call DisplayErrorMessage
    Exit Sub
    
End Sub

Sub 자간좁히기()

    Dim objUndo As UndoRecord
    Set objUndo = Application.UndoRecord
    
    On Error GoTo ErrorHandler
    
    objUndo.StartCustomRecord ("자간 좁히기")
    
    Call SetTextSpacing(ptSpacingChanged:=-0.1)
    
    objUndo.EndCustomRecord
    
    Exit Sub

ErrorHandler:
    ActiveDocument.Undo
    objUndo.EndCustomRecord
    Call DisplayErrorMessage
    Exit Sub

End Sub

Private Sub SetTextSpacing(ByVal ptSpacingChanged As Single)

    Dim aCharacter As Range
                
    On Error GoTo ErrorHandler

    For Each aCharacter In Selection.Characters
        aCharacter.Font.Spacing = aCharacter.Font.Spacing + ptSpacingChanged
    Next aCharacter
            
    Exit Sub

ErrorHandler:
    Call DisplayErrorMessage
    Exit Sub

End Sub

Sub 줄간격넓히기()

    Dim objUndo As UndoRecord
    Set objUndo = Application.UndoRecord
    
    On Error GoTo ErrorHandler
           
    objUndo.StartCustomRecord ("줄 간격 넓히기")

    Call SetLineSpacing(lnSpacingChanged:=0.1, ptSpacingChanged:=1)
       
    objUndo.EndCustomRecord
    
    Exit Sub
    
ErrorHandler:
    ActiveDocument.Undo
    objUndo.EndCustomRecord
    Call DisplayErrorMessage
    Exit Sub

End Sub

Sub 줄간격좁히기()
    
    Dim objUndo As UndoRecord
    Set objUndo = Application.UndoRecord
    
    On Error GoTo ErrorHandler
          
    objUndo.StartCustomRecord ("줄 간격 좁히기")
    
    
    Select Case ActiveWindow.View.Type
    
        Case wdOutlineView, wdMasterView
            ActiveWindow.View.ShowAllHeadings
    
        Case wdPrintView, wdWebView, wdNormalView
            Call SetLineSpacing(lnSpacingChanged:=-0.1, ptSpacingChanged:=-1)
        
    End Select

    objUndo.EndCustomRecord
    
    Exit Sub
    
ErrorHandler:
    ActiveDocument.Undo
    objUndo.EndCustomRecord
    Call DisplayErrorMessage
    Exit Sub

End Sub

Private Sub SetLineSpacing(ByVal lnSpacingChanged As Single, ByVal ptSpacingChanged As Single)

    Dim aPara As Paragraph
       
    On Error GoTo ErrorHandler
    
    For Each aPara In Selection.Paragraphs
        
        Select Case aPara.LineSpacingRule
        
            Case wdLineSpaceAtLeast, wdLineSpaceExactly
                aPara.Range.ParagraphFormat.LineSpacing = _
                    aPara.Range.ParagraphFormat.LineSpacing + ptSpacingChanged

            Case wdLineSpaceSingle, wdLineSpace1pt5, wdLineSpaceDouble, wdLineSpaceMultiple
                aPara.Range.ParagraphFormat.LineSpacing = _
                    LinesToPoints(PointsToLines(aPara.Range.ParagraphFormat.LineSpacing) + lnSpacingChanged)
            
        End Select
        
    Next aPara
                
    Exit Sub
    
ErrorHandler:
    Call DisplayErrorMessage
    Exit Sub

End Sub

Private Sub DisplayErrorMessage()

If Err.Number <> 0 Then
    MsgBox (Err.Description)
    Debug.Print Format(DateTime.Now, "yyyy-mm-dd hh:mm:ss") & " Error #" & Err.Number
End If
          
End Sub