Benutzung auf eigene Gefahr ! |
Beschreibung |
Die Funktion ist gedacht, um als Makro auf eine Schaltfläche gelegt zu werden um schnell Zitate in den Text einzufügen. Fügt einen Text aus der Zwischenablage in Word ein. Dabei werden Formatierungen und Zeilenumbrüche entfernt, Leerzeichenausgleich und TEXTEN IN GROSSBUCHSTABEN werden in normelen Text umgewandelt. |
VBA-Quelltext |
Public Sub TextEinfügen() ' Bestimmt die Zeichen, bei denen ein Leerzeichenausgleich erfolgt Const LeerzeichenAusgleich = "[a-zA-Z0-9äöüÄÖÜß]" Dim InhaltZwischenAblage As New DataObject Dim TextNeu As String, TempTxt As String, PosA As Long, PosE As Long On Error Resume Next InhaltZwischenAblage.GetFromClipboard TextNeu = Trim(InhaltZwischenAblage.GetText(1)) ' Zeilenwechsel entfernen TextNeu = Replace(TextNeu, vbNewLine, " ") ' Mehrfache Leerzeichen entfernen While InStr(1, TextNeu, " ") > 0 TextNeu = Replace(TextNeu, " ", " ") Wend ' UMWANDLUNG von TEXT In GROßBUCHSTABEN #If True Then ' Nur umwandeln, wenn ganzer Text aus Großbuchstaben besteht If TextNeu = UCase(TextNeu) Then TextNeu = StrConv(TextNeu, vbProperCase) #Else ' Wortweise prüfen und umwandeln PosE = 0 Do PosA = PosE + 1 PosE = InStr(PosA, TextNeu, " ") If PosE = 0 Then PosE = Len(TextNeu) + 1 TempTxt = Mid(TextNeu, PosA, PosE - PosA) If TempTxt = UCase(TempTxt) And (PosE - PosA) > 3 Then Mid(TextNeu, PosA, Len(TempTxt)) = StrConv(TempTxt, vbProperCase) End If Loop Until PosE > Len(TextNeu) #End If With Selection ' Leerzeichenausgleich am Anfang If .Start > 1 Then If ActiveDocument.Range(.Start - 1, .Start).Text Like LeerzeichenAusgleich Then TextNeu = " " & TextNeu End If ' Leerzeichenausgleich am Ende If ActiveDocument.Range(.End, .End + 1).Text Like LeerzeichenAusgleich Then TextNeu = TextNeu & " " ' Markierung überschreiben .Text = TextNeu End With End Sub |
Argumente der Funktion/Prozedur |
Keine. Das Makro fügt den Text aus der Zwischenablage an der zuvor gewählten Markierung ein. |
Verwendete Variable |
|
Hinweis |
Wird im Code die Anweisung für die bedingte Kompilierung #If True Then |