Private Sub ShortcutZuweisen()
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyAlt, wdKeyS), _
KeyCategory:=wdKeyCategoryMacro, Command:="saveMarkAS"
End Sub
Sub saveMarkAS()
'
' saveAS Makro
'Makro geschrieben von Johannes Gurlitt: Makro@cognitive-tools.de, bitte diesen Hinweis stehen lassen.
'Information zu diesem Makro finden sie unter www.cognitive-tools.de unter dem Link Abspeicher-Helferlein für Word(R)
'Word, Microsoft und Windows sind eingetragene Warenzeichen der Microsoft Corporation in den USA und anderen Ländern.
 nameJ = ActiveDocument.Name
    pfadJ = ActiveDocument.Path
   
    
    
    textausw = Selection.Text

    sizeString = Len(textausw)
    
    letzteZeichen = Mid(textausw, sizeString, sizeString)
    'MsgBox letzteZeichen
   ergebnisAZ = letzteZeichen Like "[A-Z]"
   ergebnisazK = letzteZeichen Like "[a-z]"
   ergebnis19 = letzteZeichen Like "#"
   
   
   'MsgBox ergebnisAZ
   'MsgBox ergebnisazK
   'MsgBox ergebnis19
   
    If ergebnisAZ Or ergebnisazK Or ergebnis19 Then
    'MsgBox "hallo"
    Else
    textausw = Mid(textausw, 1, sizeString - 1)
    End If
    
   If Len(textausw) > 2 Then
        With Dialogs(wdDialogFileSaveAs)
            .Name = pfadJ & "\" & textausw
                        .Show
        End With
    Else
        If ersteZJ = "0" Then
            Dialogs(wdDialogFileSaveAs).Show
        
        Else
        
        With Dialogs(wdDialogFileSaveAs)
            .Name = pfadJ & "\" & nameJ
            .Show
        End With
        End If
    End If

End Sub