Man kann unter Word ein klassisches Word Addin erstellen, indem man in Word-vba einen Addin-Code schreibt und dann die Word Datei als Word Vorlage mit Makros (*.dotm) speichert
*die Word Dateien sind im Download als Vorlage vorhanden. Hier könnt ihr den Code entnehmen
Erstellen eines Word-Addin
Indem man eine Datei mit vba Macro Code speichert und Word Vorlage mit Makros *.dotm
Einfügen des Addins
Im Gegensatz zu Excel und PowerPoint werden Word Addins als Word-Vorlage mit Makro .dotm gespeichert und geladen
Word Addin-code
Unter Project->Microsoft Word Objekte->ThisDocument
Damit Word als Addin Installiert wird, muss es im Document auf das Document_open() und Document_close() reagieren.
Einfach den folgenden code dort installieren
Public Sub AutoExec() ' Document_Open, Document_New, AutoOpen, AutoNew, etc. create_Addin_Menu End Sub
Public Sub AutoClose() ' Document_Open, Document_New, AutoOpen, AutoNew, etc. create_Addin_Menu End Sub
Private Sub Document_Close() Delete_Addin_Menu End Sub
Private Sub Document_Open() create_Addin_Menu End Sub
|
Word Addin-code
Unter Project->Module->mdl_Addin
Folgend der Installationscode für die CommandBars in Word-Addins
Option Explicit Option Compare Text
'*Installation Addin->Menubar
Const °AddinName As String = "Pfade_anpassen"
Sub Auto_Open() '----------------< Auto_Open() >----------------
'--< Install_MenuBar >-- Dim addin_Commandbar As CommandBar Set addin_Commandbar = find_Commandbar(°AddinName) '< check > If Not addin_Commandbar Is Nothing Then addin_Commandbar.Visible = True Exit Sub End If '</ check >
On Error GoTo 0 '--< Install_MenuBar >--
'< create new > Set addin_Commandbar = CommandBars.Add(Name:=°AddinName, Position:=msoBarFloating, Temporary:=False) '</ create new >
'----< Menue_Punkte_einfuegen >---- Dim control_Element As CommandBarButton
'------------< 1 >------------ Set control_Element = addin_Commandbar.Controls.Add control_Element.Caption = "Pfade austauschen" control_Element.OnAction = "fx_Pfade_austauschen" control_Element.FaceId = 893 control_Element.Style = msoButtonIconAndCaption control_Element.BeginGroup = True '------------</ 1 >------------ '----</ Menue_Punkte_einfuegen >----
'< anzeigen > addin_Commandbar.Visible = True '</ anzeigen >
'----------------</ Auto_Open() >---------------- End Sub
Sub Auto_Close() '----------------< Uninstall in PowerPoint ??() >--------------- '--< find_commandbar >-- Dim addin_Commandbar As CommandBar Set addin_Commandbar = find_Commandbar(°AddinName) '< check > If Err.Number <> 0 Then Exit Sub If addin_Commandbar Is Nothing Then Exit Sub '</ check > '--</ find_commandbar >--
addin_Commandbar.Delete
'----------------</ Uninstall in PowerPoint ??() >--------------- End Sub
'=====================< Helper-Functions >==============
Public Function find_Commandbar(ByVal sName As String) As CommandBar '-----------< find_Commandbar() >-------------- Dim search_Commandbar As CommandBar '----< @Loop: all_Commandbars >---- For Each search_Commandbar In Application.CommandBars If search_Commandbar.Name = sName Then '< match_return > Set find_Commandbar = search_Commandbar Exit Function 'not necessary '</ match_return > End If Next '----</ @Loop: all_Commandbars >----
'< nomatch > Set find_Commandbar = Nothing '</ nomatch > '-----------</ find_Commandbar() >-------------- End Function
'=====================</ Helper-Functions >==============
|
Beispiel Code
Pfade zu Verzeichnissen komplett Ändern in allen Word Dokumenten
Im Modul mdlPfad_aendern
Code zum Austauschen aller Links und gebundenen Grafiken und Objekte zu einem anderen Pfad
Option Explicit
'----< SETUP >---- Const °Pfad_Alt = "C:\Demo_Pfad_ALT" Const °Pfad_Neu = "D:\NEUER_PFAD" '----</ SETUP >----
Public Sub fx_Pfade_austauschen() '----------------< fx_Pfade_austauschen() >----------------
'< get_Paths > '='C:\Users\poppr\Desktop\Excel\Excel\20190214_Pfade_aendern\[Excel_mit_Wert_A_inC3.xlsx]Sheet1'!B$2 Dim sPfad_Alt As String sPfad_Alt = °Pfad_Alt sPfad_Alt = LCase(sPfad_Alt)
Dim sPfad_Neu As String sPfad_Neu = °Pfad_Neu sPfad_Neu = LCase(sPfad_Neu) '</ get_Paths >
'< init > Dim objWord As Word.Document Set objWord = ActiveDocument '</ init >
'--------< @Loop: Hyperlinks >-------- '*loop all Hyperlinks Dim sAddress As String
Dim link As Hyperlink For Each link In objWord.Hyperlinks '------< Hyperlink >------ sAddress = link.Address sAddress = LCase(sAddress) If sAddress Like "*" & sPfad_Alt & "*" Then '< Link aendern > Dim sAddress_neu As String sAddress_neu = Replace(sAddress, sPfad_Alt, sPfad_Neu, 1, , vbTextCompare) link.Address = sAddress_neu '< Link aendern > End If '------</ Hyperlink >------ Next '------</ @Loop: Hyperlink >------
Dim objShape As Shape '------< @Loop: Shapes >------ For Each objShape In objWord.Shapes '------< Shape >------ If objShape.Type = msoLinkedOLEObject Then '----< IsLinkedOLEObject >---- Dim sLink As String sLink = objShape.LinkFormat.SourceFullName sLink = LCase(sLink) If sLink Like "*" & sPfad_Alt & "*" Then '< Link aendern > Dim sLink_neu As String sLink_neu = Replace(sLink, sPfad_Alt, sPfad_Neu, 1, , vbTextCompare) objShape.LinkFormat.SourceFullName = sLink_neu '< Link aendern > End If '----</ IsLinkedOLEObject >---- End If '------</ Shape >------ Next '------</ @Loop: Shapes >------
'------</ Change_Cells >------
'< Abschluss > MsgBox "Fertig" '</ Abschluss > '----------------</ fx_Pfade_austauschen() >---------------- End Sub
|