Text einfügen

Sprache / Programm: Word ab Version 2000

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

InhaltZwischenAblage: Variable, um das DataObject der Zwischenablage aufzunehmen
TextNeu: Variable, um den einzufügenden Text vor dem Einfügen zu bearbeiten

Hinweis

Wird im Code die Anweisung für die bedingte Kompilierung

#If True Then

auf False gesetzt,