VBA-Code um Textbaustein-Manager innerhalb von Winword aufzurufen – interessant für Arztbriefe, Gutachten, Rechtsanwälte usw. VBA-Erweiterung von Word um mit einem zentral gespeicherten Textbaustein-Bestand direkt aus Winword auf allen Computer in der Ordi arbeiten.
Erstellen von oft vielseitigen Gesprächszusammenfassungen
Beim Schreiben von Arztbriefen oder Gesprächszusammenfassungen verwende ich viele Textbausteine mit tw. sehr langen und ausführlichen Informationen.
Mehrseitige Texte mit Grafik und Spalten-Satz – das überfordert die “F3 Autotext-Funktion” von Winword, weil es die “Normal.dot” extrem aufbläst und verlangsamt und komplexe Formatierungen (Spalten) in F3 nicht korrekt mitabspeichert.
Mit TexManager hab ich ein super tool – ich hab schon ausführlich drüber geschrieben.
Meine TexManager-Textbausteine liegen als Word-Files am NAS, ich kann von jedem Computer aus drauf zugreifen und sie in Word übernehmen.
Komplexere Funktionen wie Verkettung von Textbausteinen oder Serienbrief-Funktion oder so brauch ich alles nicht, nur eine schnelle und prompte Servicierung mit den vielen vielen Texten, mit denen ich täglich zu jonglieren habe!
Mein Supertolles “Arztbrief-Center” mit dem automatisch auf einen Klick Briefe + Rezepte + Verrechnung usw. rauskommen – Screen-Cuts hab ich im ersten Artikel gezeigt verwende ich dann in der Praxis doch nicht, weil die Fragestellungen und Arztbriefe doch so individuell sind, dass ich sie besser mit Textbausteinen beantworte.
TexManager – Textbausteine direkt in Winword
Was wäre cool? Ein Auswahlfenster in Winword, mit dem ich diese Textbausteine aufrufen und auswählen könnte. Ich hab in der Buttonleiste das rote Herz, wenn ich das anklicke
Danke nochmal an Programmierer Jürgen Knauf von der TexManager Firma, der mir in den Feiertagen prompt geholfen hat (weil Doku etwas unklar war).
Hier ist der Code für Winword – VBA
- mit F11 den VBA-Editor starten
- ein Userform anlegen (Menü Einfügen – UserForm)
- Menü Ansicht Werkzeugsammlung anstellen
- eine Listbox in das Userform: Listbox1
- eine Combobox in das Userform: Combobox1
- einen Button in das Userform: umbenannnt in BtnFülleTextbaustein
dann durch F7 öffnet sich das Codefenster, hier ist der Code dazu
‘hier im Code müssen die typographischen Anführungszeichen für VBA-Editor korrigiert werden
Dim tmWord As Object
Dim aSearch() As Variant
Dim cFileName As String
Dim nHits As Integer
Const cNoValue = -99
Private Sub FülleTextbausteine()
Dim i As Long, j As Long, s As String, s1 As String, a() As String
Set tmWord = CreateObject(“tmWord.Server”)
If tmWord Is Nothing Then
MsgBox “konnte Textbaustein.Server nicht finden”
Exit Sub
End If
aSearch = tmWord.SearchTbSql(“*”, “OrdiRetzek-Textbausteine”, “SNAME”)
For i = LBound(aSearch) To UBound(aSearch)
If aSearch(i, 1) <> “” Then
s = s + vbCrLf & aSearch(i, 1) + ” | ” + aSearch(i, 2)
End If
Next
a = Split(s + vbCrLf, vbCrLf)
a = SortArrayAtoZ(a)
s = Join(a, vbCrLf)
Debug.Print s
For i = LBound(a) To UBound(a)
If a(i) <> “” Then
Me.ListBox1.AddItem (a(i))
Me.ComboBox1.AddItem (a(i))
End If
Next
‘Unload TexManagerForm
End Sub
Function SortArrayAtoZ(myArray As Variant) As Variant
Dim i As Long
Dim j As Long
Dim Temp
‘Sort the Array A-Z
For i = LBound(myArray) To UBound(myArray) – 1
For j = i + 1 To UBound(myArray)
If UCase(myArray(i)) > UCase(myArray(j)) Then
Temp = myArray(j)
myArray(j) = myArray(i)
myArray(i) = Temp
End If
Next j
Next i
SortArrayAtoZ = myArray
End Function
Private Sub BtnFülleTextbausteine_Click()
If Me.ListBox1 <> “” Then CreateTextBaustein (Me.ListBox1)
End Sub
Private Sub ComboBox1_AfterUpdate()
Dim f As MSForms.ReturnBoolean
‘Call ListBox1_DblClick(f)
‘If ComboBox1 <> “” Then CreateTextBaustein ComboBox1
‘liefert eine Fehlermeldung, vermutlich wird das ENTER nicht aus dem System entfernt auch wenn Form geschlossen wird
End Sub
Private Sub ComboBox1_Change()
Dim s As String
s = ComboBox1
If s <> “” Then Me.ListBox1 = s
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim s As String, nSeek As Long
If Me.ListBox1 <> “” Then CreateTextBaustein (Me.ListBox1)
End Sub
Private Sub CreateTextBaustein(which As String)
‘On Error GoTo er
Dim s As String, i As Long
s = Trim(Split(which, ” | “)(0))
tmWord.Suche (s)
nSeek = tmWord.nFound
If nSeek = 1 Then
‘Selection.Collapse wdCollapseEnd
Selection.Paste
If Err Then MsgBox “nix im Clipboard?!”: Err.Clear
End If
i = Timer
Unload TexManagerForm
Exit Sub
er:
‘MsgBox “Fehler in CreateTextBaustein: ” + CStr(Err.Number) + ” ” + Err.Description
End Sub
Private Sub UserForm_Initialize()
FülleTextbausteine
End Sub
wieso die Combobox?
Listbox und Combobox haben beide denselben Inhalt und dieselbe Funktion
wenn man aber viele Textbausteine hat ist die Listbox zu langsam und unübersichtlich weil man zum scrollen anfangen muss, die Listbox reagiert nämlich nur auf den ersten Buchstaben, die Combobox auf mehrere Buchstaben, so kann man schön eingrenzen.
Leider kann ich in der Combo nicht mit ENTER einfach übernehmen, macht Fehlermeldung, desswegen der Button daneben.
In der Listbox wählt man den Textbaustein durch Doppelklick aus.
Wie ruft man das Formular jetzt auf
man legt sich einen eigenen Makro zurecht namens DoTexManagerForm, den kann man dann auf die Tastatur oder auf die Icon-Leiste raufprogrammieren.
Public Sub DoTexManagerform()
TexManagerForm.Show
End Sub
was ist mit PhraseExpress?
PhraseExpress – mein zweiter Textbaustein-Manager mit noch viel universellerer Einsatzmöglichkeit – weil er Textbausteine völlig unabhängig vom Programm einfügen kann – bringt meinen Computer leider zum Abstürzen was vielleicht auch daran liegt, dass ich immer noch in Office 2003 arbeite, weil das die letzte gut funktionierende ACCESS – Version war).
Egal, ich bin mit der aktuellen Variante TexManager super zufrieden, da ich sie sowohl in mein ACCESS-Praxisprogramm wie auch direkt in Word einbinden kann, was mit PhraseExpress nicht geht.
Nachtrag – Anlegen von neuen Textbausteinen direkt in Winword mit dem obigen Formular
ich habe folgende tolle Erweiterung in mein Formular gemacht:
Textbaustein in Winword direkt in die TExtbaustein-Datenbank am NAS reinkopieren.
dazu auf das Formular oben einen zusätzlichen Button, und folgenden VBA-Programmtext auf den Button legen. Damit dieser Button nur angezeigt wird, wenn auch ein Text ausgewählt ist den man zu einem Textbaustein umwandeln kann, hab ich die Startprozedur erweitert um die *** Zeile
Private Sub UserForm_Initialize()
Dim s As String
FülleTextbausteine
*** Me.btnSaveTextbaustein.Visible = Len(Selection.Text) > 3
End Sub
Private Sub btnSaveTextbaustein_Click()
Dim s As String, lOK As Long
‘tmWord.AddText
tmWord.AddText
lOK = tmWord.lOK
If lOK Then
Selection.MoveDown Unit:=wdLine, Count:=1
Me.ListBox1.Clear
Me.ComboBox1.Clear
Call FülleTextbausteine
MsgBox “der Textbaustein wurde angelegt, die Liste hier neu befüllt”
Else
lOK = MsgBox(“Der Text konnte nicht gespeichert werden!”, vbCritical, “Achtung”)
End If
End Sub
Super super super super tool, das spart mir ganz viel Mühe!!!
Ich kann quer über alle 6 Computer, die ich in der Ordi verwende, einen Stamm an Textbausteinen synchron halten
