VBA Nachschlagewerk Pirmin Steiner

Wenn Sie einem Makro einen speziellen Namen geben, können Sie es automatisch ausführen, wenn Sie einen Vorgang wie das Starten von Word oder das Öffnen eines Dokuments ausführen. Word erkennt die folgenden Namen als automatische Makros:

Name des Makros	Ausführung
Autoexec	Beim Starten von Word oder Laden einer globalen Vorlage
AutoNeu	Beim Erstellen eines neuen Dokuments
AutoOpen	Beim Öffnen eines vorhandenen Dokuments
Autoclose	Beim Schliessen eines Dokuments
Autoexit	Beim Beenden von Word oder Entladen einer globalen Vorlage

Automatische Makros werden in Codemodulen erkannt, wenn sie eine der folgenden Bedingungen erfüllen.

Das Modul ist nach dem Namen des automatischen Makros benannt (z. B. "AutoExec") und enthält eine Prozedur mit der Bezeichnung "Main".

Prozeduren werden in allen Modulen nach dem automatischen Makro benannt.

Zum Dokumentbeginn

Diverse Einzeiler:

Selection.EndKey Unit:=wdStory 'Ans Ende des Dokumentes springen

Selection.MoveUp Unit:=wdLine, Count:=1 'Eine Zeile nach oben

Selection.MoveRight Unit:=wdCell 'Tabulator einfügen, Tabelle erweitern

Selection.HomeKey Unit:=wdStory 'An den Beginn des Dokumentes springen

ActiveDocument.Save 'Aktives Dokument speichern

Documents("MeinDokument.doc").Activate 'Dokument mit Namen X Aktivieren

Documents().Close SaveChanges:=wdDoNotSaveChanges 'Dokument schliessen ohne speichern

ActiveDocument.ActiveWindow.Close SaveChanges:=wdSaveChanges 'Dokument schliessen mit speichern

ActiveDocument().Close SaveChanges:=wdPromptToSaveChanges 'Speichern wenn etwas geändert hat, mit Abfrage

ActiveDocument.Close 'Dokument schliessen

Selection.TypeText Application.UserInitials 'User Kurzzeichen aus Optiondlg einfügen

strDokname = ActiveDocument.Name 'DokName in Variable strDokname speichern

Dialogs(wdDialogToolsAutoManager).Show 'Listet die Dialogbox Autotexte auf

Dialogs(wdDialogToolsMacro).Show 'Listet die Dialogbox der Makros auf

ActivePrinter = \\andererPC\HP LaserJet 4000 Series PCL 5e 'Auf anderen Drucker drucken (nicht ausprobiert)

ActiveDocument.PrintOut Copies:=4 'Anzahl Dokumente drucken z.B. hier 4 Stk.

ChangeFileOpenDirectory "C:\" 'Beim öffnen Default Pfad angeben

Dialogs(wdDialogFileOpen).Show 'Dialogfeld öffnen anzeigen

dlgAnswer = Dialogs(wdDialogFileOpen).Show 'Zurückgeben Antwort ob etwas ausgewählt im Dialog

wdDialogEditFind 'Dialogfeld Suchen

wdDialogToolsOptionsUserInfo 'Dialogfeld Optionen Benutzerangaben

Dialogs(wdDialogViewZoom).Show TimeOut:=9000 'Zeigt ein Dialogbox hier zB. 9 Sekunden an

ActivePrinter = "" 'Stellt auf den Standard-Drucker zurück

Dialogs(wdDialogFilePrint).Show 'Dialogfeld Drucken... anzeigen

ActiveDocument.PrintOut 'Befehl für Drucken > 'DateiDruckenStandard'

MsgBox ActiveDocument.Name 'Gibt den Namen des aktuellen Dokumentes zurück

Dialogs(wdDialogEditFind).Show TimeOut:=9000 'Dialogfeld Suchen 9sek anzeigen

ActiveWindow.ActivePane.View.Type = wdNormalView 'Auf Normalansicht wechseln

Application.WindowState = wdWindowStateMaximize 'Dokument Ansicht Vollbild

Application.WindowState = wdWindowStateNormal 'Dokument Ansicht Nicht Vollbild

Application.WindowState = wdWindowStateNormal 'Word-Fenster auf maximiert (nicht vollbild) Ansicht

Application.Resize Width:=577, Height:=274 'Word-Fenster auf maximiert (genaue grösse definiert)

Ansicht

ActiveWindow.ActivePane.View.Type = wdPrintView 'Wechseln auf Layout Ansicht

ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader 'Ansicht Kopfzeile

NormalTemplate.AutoTextEntries("Generali").Insert Where:=Selection.Range 'Autotext einfügen

Kill "C:\UserEinstellungen.ini" 'Datei löschen

Application.OnTime When:=Now + TimeValue("00:00:02"), _

Name:="TemplateProject.OptionenAnsichtLesen.OptionenAnsichtLesen" 'Modul nach einer gewissen Zeit laufen lassen

Application.Run "MyProject.MyModule.MyProcedure" 'Modul ausführen Projektneme,Modulneme,Prozedurname

Chr(13) 'Absatzmarke

Selection.TypeText Text:="EscSecuenz" 'Autotext von EscSecuenz einfügen 1. Schritt

Selection.Range.InsertAutoText 'Autotext von EscSecuenz einfügen 2. Schritt

Public strSprache As String 'Variablenwert für ganzes Projekt vergfügbar machen

Selection.MoveDown Unit:=wdParagraph, count:=1, Extend:=wdMove 'Zum 1. Anfang des nachfolg. Absatzes

Selection.MoveUp Unit:=wdParagraph, count:=1, Extend:=wdMove 'Zum Beginn des 1. vorherigen Absatzes

With Selection 'Beginn Zeile springen und bis Ende Absatz markieren

.StartOf Unit:=wdParagraph, Extend:=wdMove

.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend

End With

Options.PrintReverse = True 'Drucken in Umgekehrter Reihenfolge

MsgBox ActiveDocument.Sections.Count & " Abschnitte." 'Gibt die Anzahl der Abschnitte im Dokument retour.

ActiveDocument.ActiveWindow.ActivePane.AutoScroll velocity:=60 'Seite automatisch nach unten scrollen.

Selection.Paragraphs(1).Range.Select 'Bis Ende nächster Absatzmarke markieren.

ActiveDocument.Paragraphs(2).Range.Select 'Die ersten zwei Absätze im Dokument markieren

strTextFont = Selection.Font.Name 'Font-Name in eine Variable abfüllen

intHyperlinkAnzahl = ActiveDocument.Hyperlinks.Count 'Anzahl der Hyperlinks abfragen

'Hyperlink aus VBA im Explorer öffnen:

ActiveDocument.FollowHyperlink Address:="http://office.microsoft.com", NewWindow:=True, AddHistory:=True

strTextmarkenInhalt = ActiveDocument.Bookmarks("SysTextmarke").Range.Text 'TM Inhalt in Variable lesen

strSeite = ActiveDocument.Bookmarks("strgaga").Range.Information(wdActiveEndPageNumber) 'SeitenNr. der TM o. Mark.

ActiveDocument.ActiveWindow.Caption = ActiveDocument.FullName 'In diesem Beispiel wird die Beschriftung des
'aktiven Fensters auf den Namen des aktiven Dokuments
'eingestellt.

ActiveWindow.ActivePane.View.NextHeaderFooter 'Abschnitte zählen

strAbschwievoriger = Selection.HeaderFooter.LinkToPrevious 'Abfragen ob der Abschnitt (Kopf-Fussz.) wie vorheriger

ist

strPfad = ActiveDocument.AttachedTemplate.Path & Application.PathSeparator 'Gibt den Pfad des Aktiven Templates
zurück, inkl /

strTemplateName = ActiveDocument.AttachedTemplate.Name 'Gibt den Namen des Templates zurück

MsgBox CreateObject("WScript.Network").UserName Login-Name des aktuell in Windows angemeldeten Benutzers

strFormatvorlage = ActiveDocument.Styles(Selection.Style) 'Gibt die Formatvorlage des Markierten Textes zurück

strBenötigterDrucker = LCase (strSysPrintDest) 'Alles kleinscheiben

strBenötigterDrucker = UCase(strSysPrintDest) 'Alles auf Grosschreibung setzen

strTextmarkenInhalt = Left(strTextmarkenInhalt, Len(strTextmarkenInhalt) - 1) 'Letztes Zeichen in einem String
entfernen

Temp für Wait (Sleep)

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sleep 500 '(500 = 500 Millisekungen = 0.5 Sekunden Warten)

ActiveDocument.PageSetup.DifferentFirstPageHeaderFooter = False 'Erste Seite nicht anders 2010

ActiveDocument.PageSetup.OddAndEvenPagesHeaderFooter = False 'Untersch. gerade ungerade Seiten 2010

ActiveDocument.UndoClear 'Rückgängig Speicher löschen

stsZeilenNummer = Selection.Information(wdFirstCharacterLineNumber) 'ZeilenNummer

stsZeilenNummerPos = Selection.Information(wdFirstCharacterColumnNumber) ' Position des Zeichens

strAnzahlSeiten = ActiveDocument.ComputeStatistics(wdStatisticPages) 'Anzahl Seiten des Dokuments ermitteln

strSeite = ActiveDocument.Bookmarks("SysPapierPolice").Range.Information(wdActiveEndPageNumber) 'Auf welcher Seite

ist die Textmarke

strAktuellesModul = Application.VBE.ActiveCodePane.CodeModule 'Aktuelles Modul

strAktuellesProjekt = Application.VBE.ActiveVBProject.Name 'Projekt Name

strAktuellesModul2 = Application.VBE.ActiveCodePane.CodeModule.Name 'Aktuelles Modul

Exit For 'If Schlaufe verlassen

ActiveDocument.CopyStylesFromTemplate ("C:\Temp\police_m.dotm") 'Alle Formatvorlagen ins Aktive Dokument kopieren

intSchirmhoehe = Application.UsableHeight 'Bildschirmhöhe ermitteln

intSchirmbreite = Application.UsableWidth 'Bildschirmbreite ermitteln

WordBasic.SelectSimilarFormatting 'Im Dokument der Text markieren, welcher die gleiche Formatierung hast wie welcher wo der Coursor steht.

ActiveWindow.View.SeekView = wdSeekCurrentPageFooter 'Direkt in Fusszeile wechseln

ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument 'Fusszeile wieder schliessen

MsgBox ActiveDocument.ComputeStatistics(Statistic:=wdStatisticLines) 'Anzahl Absatzmarken im Dokument

MsgBox ActiveDocument.Paragraphs.Count 'Anzahl Absatzmarken im Dokument

StrPath = ActiveDocument.Path & Application.PathSeparator 'Pfad vom Dokument

Zum Dokumentbeginn

Dokument schliessen ohne Speichern:

Sub Makro9()

' IO Dokument wird ohne Speichern geschlossen

Documents().Close SaveChanges:=wdDoNotSaveChanges

End Sub

'In diesem Beispiel wird das aktive Dokument gespeichert, wenn es Änderungen enthält, die zuvor nicht gespeichert wurden.

If ActiveDocument.Saved = False Then ActiveDocument.Save

'Abfragen ob beim SaveAs (Dialog Speichern unter) Abbrechen oder Speichern gewählt wurde.

binSaved = ActiveDocument.Saved

'Bringt auf binSaved (die Variable) Wahr oder Falsch zurück (Boolean)

'Bei diesem Dialogfeld:

Set dlg = Dialogs(wdDialogFileSaveAs)

With dlg

.Name = strDocFullName

.Show

End With

Dokument drucken und schliessen ohne Speichern:

Sub Dok()

Set myRange = ActiveDocument.Range(Start:=0, End:=0)

ActiveDocument.PrintOut

Documents().Close SaveChanges:=wdDoNotSaveChanges 'Dok schliessen ohne Speichern

End Sub

Zum Dokumentbeginn

Autotextdialog anzeigen

Sub AutotextAnzeigen()

' Dieses Makro listet das Dialogfeld der Autotexte auf.

Dialogs(wdDialogToolsAutoManager).Show

End Sub

Zum Dokumentbeginn

Makrodialogbox anzeigen:

Sub MakroAufstellungB()

' Dieses Makro listet das Dialogfeld der Makros auf.

Dialogs(wdDialogToolsMacro).Show

End Sub

Zum Dokumentbeginn

Textmarkendialogbox anzeigen:

Sub TextmarkenAnzeigenB()

' TextmarkenAnzeigen Makro

' In diesem Beispiel wird das integrierte Dialogfeld Textmaken angezeigt.

' Im Dialogfeld werden alle Textmarken angezeigt.

With Dialogs(wdDialogInsertBookmark)

.Name = ""

.Show

End With

End Sub

Zum Dokumentbeginn

Markierter Text aus Dokument in MsgBox ausgeben (markierung):

'Aus Dokument lesen / Alles was Markiert ist wird in der MsgBox ausgegeben.

Sub LesenB()

Dim strLesen As String

strLesen = Selection.Text

MsgBox strLesen

End Sub

Zum Dokumentbeginn

Markierung von Textmarke zu Textmarke:

Sub MarkierungVonBisTextm()

' Hier wird von den Textmarken SysBEGUTitel bis SysBEGU eine

' Markierung erstellt, natürlich zuerst abfragen obs diese gibt.

If ActiveDocument.Bookmarks.Exists("SysBEGUTitel") = True Then

If ActiveDocument.Bookmarks.Exists("SysBEGU") = True Then

Selection.GoTo What:=wdGoToBookmark, Name:="SysBEGUTitel"

Selection.Extend

Selection.GoTo What:=wdGoToBookmark, Name:="SysBEGU"

' Und die Markierung noch weiter ziehen bis SysBEGUEnde

Selection.GoTo What:=wdGoToBookmark, Name:="SysBEGUEnde"

End If

End Sub

Zum Dokumentbeginn

InputBox

'Die InputBox Eingabe wird immer in eine Variable abelegt. Darum die Klammern!

Sub inBox()

Dim strEingabe As String

strEingabe = InputBox("Bitte Namen eingeben.", "Namenseingabe", "Hans Muster")

MsgBox "Sie heissen " & strEingabe

End Sub

Zum Dokumentbeginn

Speichern unter anzeigen:

Sub SpeichernUnter()

With Dialogs(wdDialogFileSaveAs)

.Name = ""

.Show

End With

End Sub

Zum Dokumentbeginn

Organisierendialogbox anzeigen:

Sub Organisieren()

With Dialogs(wdDialogOrganizer)

.Name = ""

.Show

End With

End Sub

Zum Dokumentbeginn

Text suchen und wenn gefunden MsgBox anzeigen:

Public Sub TextSuchen()

'Wenn Sie zum Find-Objekt aus dem Range-Objekt gelangt sind, wird die

'Markierung nicht geändert, wenn der Text ermittelt wird, der mit den

'Suchkriterien übereinstimmt. Es wird jedoch das Range-Objekt neu

'definiert. Das folgende Beispiel sucht das erste Auftreten des Worts

'"blue" im aktiven Dokument. Wird das Wort "blue" im Dokument ermittelt,

'wird myRange neu definiert und das Wort "blue" fett formatiert.

Set myRange = ActiveDocument.Content

myRange.Find.Execute FindText:="bluqe", Forward:=True

If myRange.Find.Found = True Then

MsgBox "hallo gefunden"

'myRange.Bold = True

End If

End Sub

Zum Dokumentbeginn

Textteil aus Variable lesen und verändern

Public Sub TextSuchenInVariablenInhalt()

' Textmarken-Inhalt, welcher in einer Variablen abgelegt ist durchsuchen

' und einen Teil davon Textlich verändern. z.B. Hier Font Kleiner- und Höherstellen

If ActiveDocument.Bookmarks.Exists("produktnamen") = True Then

Set myRange = ActiveDocument.Bookmarks("produktnamen").Range

myRange.Find.Execute FindText:="FL", Forward:=True

If myRange.Find.Found = True Then

intSchriftgroesse = myRange.Font.Size

myRange.Font.Size = intSchriftgroesse - 3

myRange.Font.Position = 3

' könnte auch nur mit dieser Zeile für Font.Hochgestellt erfolgen:

myRange.Font.Superscript = True

End If

End Sub

Public Sub TextSuchenInVariablenInhalOKOK()

' Textmarken-Inhalt, welcher in einer Variablen abgelegt ist durchsuchen

' und einen Teil davon Textlich verändern. z.B. Hier Font Kleiner- und Höherstellen

If ActiveDocument.Bookmarks.Exists("produktnamen") = True Then

Set myRange = ActiveDocument.Bookmarks("produktnamen").Range

myRange.Find.Execute FindText:="FL ", MatchCase:=True, Forward:=wdForwardAll ' mit Gross/Kl.schreibung
' beachten und letztes Vorkommen im String

If myRange.Find.Found = True Then

myRange.Font.Superscript = True

End If

End Sub

Zum Dokumentbeginn

Ist die Textmarke vorhanden, dann auf diese springen:

If ActiveDocument.Bookmarks.Exists("SysUser") = True Then ' Ist die Textmarke SysAbsatz vorhanden

Selection.GoTo What:=wdGoToBookmark, Name:="SysUser"

With ActiveDocument.Bookmarks

.DefaultSorting = wdSortByName

.ShowHidden = True

End With

End If

Zum Dokumentbeginn

Textmarken aus einem Dokument lesen und in die Variable strMarksVork speichern:

If ActiveDocument.Bookmarks.Count >= 1 Then 'Sind Textmarken vorhanden?

ReDim strMarksVork(1000) ' Grösse auf 100 Elemente ändern.

ActiveDocument.Bookmarks().Application.Activate ' Aktuelles Dokument Aktivieren

If ActiveDocument.Bookmarks.Count >= 1 Then

ReDim strMarksVork(ActiveDocument.Bookmarks.Count - 1) ' So manchmal die Variabl. abfüllen

e = 0 ' wie es Textmarken gibt.

For Each strBookmark In ActiveDocument.Bookmarks

strMarksVork(e) = strBookmark.Name ' Variable mit TextmarkenNamen abfüllen

e = e + 1 ' Angeben wie hoch die Variable erst. werden muss

Next strBookmark

End If

Zum Dokumentbeginn

Textmarken u. DokName einfügen wenn es diese im aktuellen Dokument nicht gibt:

' Textmarken einfügen

' Hier wird abgefragt ob es den eintrag 'Textmarke und Dokumentnamen schon gibt.

' Wenn es diesen im Zusammenfassungs-Dokument schon gibt wird dieser Eintrag nicht

' vorgenommen.

For intZählerVork = 0 To e – 1 ' Anzahl Durchläufe festlegen

Set myRange = ActiveDocument.Content

myRange.Find.Execute FindText:=strMarksVork(intZählerVork) & vbTab & strDoknameVork, Forward:=True

If myRange.Find.Found = True Then

Selection.HomeKey Unit:=wdStory 'An den Beginn des Dokumentes springen

Else

Selection.EndKey Unit:=wdStory 'Ans Ende des Dokumentes springen

Selection.MoveUp Unit:=wdLine, Count:=1 'Eine Zeile nach oben

Selection.MoveRight Unit:=wdCell 'Tabulator einfügen, Tabelle erweitern

Selection.TypeText strMarksVork(intZählerVork) & vbTab & strDoknameVork ' -e darum weil 0 mitgezählt wird

Count = Count + 1 ' Counter angeben mit welchem wert gezählt wird

End If

Zum Dokumentbeginn

Beispiel Dokument suchen:

'Beispiel zur Execute-Methode (FileSearch-Objekt)

'In diesem Beispiel wird im Ordner My Documents nach allen Dateien gesucht, die die Dateinamenerweiterung .doc

'haben. Für jede gefundene Datei wird anschliessend der Pfad und der Name angezeigt. Die Liste der zurückgegebenen

'Dateien wird ausserdem in aufsteigender alphabetischer Reihenfolge sortiert.

Set fs = Application.FileSearch

With fs

.LookIn = "C:\My Documents"

.FileName = "*.doc"

If .Execute(SortBy:=msoSortbyFileName, _

SortOrder:=msoSortOrderAscending) > 0 Then

MsgBox "There were " & .FoundFiles.Count & _

" file(s) found."

For i = 1 To .FoundFiles.Count

MsgBox .FoundFiles(i)

Next i

Else

MsgBox "There were no files found."

End If

End With

Zum Dokumentbeginn

Alle Textmarken in eine Variable speichern:

Sub TextmarkenSuche()

' Anstatt jeden Elementnamen in einem Meldungsfeld anzuzeigen,

' können Sie ein Datenfeld zum Speichern der Informationen verwenden.

' In diesem Beispiel wird das Datenfeld aMarks() zum Speichern des

' Namens jeder Textmarke verwendet, die im aktiven Dokument enthalten ist.

If ActiveDocument.Bookmarks.Count >= 1 Then

ReDim aMarks(ActiveDocument.Bookmarks.Count - 1)

i = 0

For Each aBookmark In ActiveDocument.Bookmarks

aMarks(i) = aBookmark.Name

i = i + 1

Next aBookmark

End If

Zum Dokumentbeginn

Tabelleninhalte lesen und in Variable speichern:

Sub Makro11()

' TABELLENINHALT IN EINE VARIABLE SPEICHERN

'Dim aCells As String ' Dynamisches Datenfeld für Zähler deklarieren

'Dim strTabText As String ' Dynamisches Datenfeld für Zähler deklarieren

ReDim strTabText(1000000) ' Grösse auf 1000 Elemente ändern.

If ActiveDocument.Tables.Count >= 1 Then

Set oTable = ActiveDocument.Tables(1)

intNummer = oTable.Range.Cells.Count

ReDim strTabText(intNummer)

i = 1

For Each oCell In oTable.Range.Cells

Set myRange = oCell.Range

myRange.MoveEnd Unit:=wdCharacter, Count:=-1

strTabText(i) = myRange.Text

Selection.TypeText strTabText(i) 'Text einfügen

Selection.MoveRight Unit:=wdCell 'Tab einfügen

i = i + 1

Next oCell

End If

End Sub

Zum Dokumentbeginn

Vergleichen von zwei Variablen:

Sub Vergleich()

Dim intHansAlter As Integer

Dim intSusiAlter As Integer

intHansAlter = 7

intSusiAlter = 6

If intHansAlter > intSusiAlter Then

MsgBox "Hans ist älter"

ElseIf intHansAlter = intSusiAlter Then

MsgBox "Beide sind geleich alt"

Else

MsgBox "Susi ist älter"

End If

End Sub

Zum Dokumentbeginn

Zählerschlaufe

Sub Zähler()

Dim intZähler As Integer 'Zälervarable als Integer festlegen.

For intZähler = 1 To 20 Step 5 'von 1 bis 20 durchzählen

'Step 5 ein druchlaufen im 5er Schrittt

Selection.TypeText "Dies ist die Zählschlaufe Nr.: " & intZähler 'Einfügen Text u. Zähler

Selection.TypeParagraph 'Absatzmarke Einfügen

Next intZähler 'Wieder an Anfang

End Sub

Zum Dokumentbeginn

Bedingungsschleife

Sub Bedingteschleife()

Dim intBZähler As Integer 'Zälervarable als Integer festlegen.

intBZähler = 1 'Variablenwert definieren

Do While intBZähler <= 100 'Anzahl Durchläufe festlegen

Selection.TypeText "Dies ist die Bedingungsschlaufe Nr.: " & intBZähler

Selection.TypeParagraph

intBZähler = intBZähler + 2 'Angeben um welchen Wert der Zähler erhöt wird

Count = Count + 1 'Counter angeben mit welchem wert gezählt wird

Loop 'Wieder an Anfang

End Sub

Zum Dokumentbeginn

Bedingungsschleife 2 Bedingung am Schluss der Schlaufe

'Bedingungsschleife 2 Bedingung am Schluss der Schlaufe (Einmal wird diese immer durchlaufen!)

Sub Bedingteschleife2()

Dim intBZähler As Integer 'Zälervarable als Integer festlegen.

intBZähler = 1 'Variablenwert definieren

Do 'Durchläufe festlegen

Selection.TypeText "Dies ist die Bedingungsschlaufe Nr.: " & intBZähler

Selection.TypeParagraph

intBZähler = intBZähler + 2 'Angeben um welchen Wert der Zähler erhöt wird

Count = Count + 1 'Counter angeben mit welchem wert gezählt wird

Loop While intBZähler <= 100 'Wieder an Anfang mit Bedingung_f_h_k_l

End Sub

Zum Dokumentbeginn

MousOver

' Lässt eine MsgBox erscheinen, wenn der Mauszeiger über die Schaltfläche OK fährt.

Private Sub cmdOK_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _

ByVal X As Single, ByVal Y As Single) 'Zeile mit leer + _ abgeschlossen und umgebrochen

MsgBox "Test Maus über OK"

End Sub

Zum Dokumentbeginn

Feststellen auf welcher Seite der Cursor sich befindet.

Public Sub MAIN()

' Hier wird abgefragt ob der Cursor sich auf der 1. Seite

' befindet

'-------------------------------------------------------------

If WordBasic.SelInfo(3) = 1 Then

WordBasic.MsgBox "Dies ist die 1. Seite"

End If

' Hier wird abgefragt ob der Cursor sich auf der 2. Seite

'befindet

'-------------------------------------------------------------

If WordBasic.SelInfo(3) = 2 Then

WordBasic.MsgBox "Dies ist die 2. Seite"

End If

' Hier wird abgefragt ob der Cursor sich auf der 3. Seite

' befindet

'-------------------------------------------------------------

If WordBasic.SelInfo(3) = 3 Then

WordBasic.MsgBox "Dies ist die 3. Seite"

End If

End Sub

Zum Dokumentbeginn

Dokumenteigenschaften setzen

'In der Regel werden Sie den Makrorecorder benutzen, um die Namen von Objekten, Eigenschaften und Methoden zu

'erfahren, die Sie in VBA nachbilden möchten. Beim Setzen von Dokumenteigenschaften stossen Sie dabei auf einen

'Fehler des Makrorecorders in Word. Er ist nicht in der Lage, diese Operation aufzuzeichnen. Um die

'Dokumenteigenschaften von VBA aus einzustellen, verwenden Sie die Eigenschaft BuiltInDocumentProperties des

'ActiveDocument-Objekts und eine Konstante, die die einzelne Eigenschaft angibt. Die folgende Prozedur setzt die

'Werte für die Eigenschaften Titel, Autor und Kategorie durch die ihr übergebenen Werte.

Sub DokumenteigenschaftenSetzen(strTitel As String, _

strAutor As String, strKategorie As String)

With ActiveDocument

.BuiltInDocumentProperties(wdPropertyTitle) = strTitel

.BuiltInDocumentProperties(wdPropertyAuthor) = strAutor

.BuiltInDocumentProperties(wdPropertyCategory) = strKategorie

End With

End Sub

Public Sub DokumenteigenschaftenSetzen()

On Error GoTo Ende:

'Setzt die Dokumenteigenschaften des aktiven Dokumentes

Dim strTitel As String

Dim strThema As String

Dim strAutor As String

Dim strManager As String

Dim strKategorie As String

Dim strFirma As String

Dim strDocName As String

Dim strKommentar As String

Dim strHyperlink As String

strDocName = ActiveDocument.Name

strTitel = strDocName 'InputBox("Der Titel der Druckvorlage", "Dokumenteigenschaften setzen", strDocName)

If strTitel = "" Then

'Nichts machen, da Abbrechen gewählt wurde!

Else

strThema = "Dokumentvorlage für VVEV"

strAutor = "Pirmin Steiner"

strManager = "Pirmin Steiner (DO/stp)"

strKategorie = "Winword Dokumentvorlage"

strFirma = "GENERALI Personenversicherungen"

strKommentar = "Erstellt/Geändert am: " & vbCrLf & "Datum: " & Date & vbCrLf & "Zeit: " & Time & vbCrLf & "Durch: DO/stp"

strThema = "Druckvorlage (Winword 2000)"

strHyperlink = "www.generali.ch"

With ActiveDocument

.BuiltInDocumentProperties(wdPropertyTitle) = strTitel

.BuiltInDocumentProperties(wdPropertyAuthor) = strAutor

.BuiltInDocumentProperties(wdPropertyManager) = strManager

.BuiltInDocumentProperties(wdPropertyCategory) = strKategorie

.BuiltInDocumentProperties(wdPropertyCompany) = strFirma

.BuiltInDocumentProperties(wdPropertyComments) = strKommentar

.BuiltInDocumentProperties(wdPropertyHyperlinkBase) = strHyperlink

.BuiltInDocumentProperties(wdPropertySubject) = strThema

End With

End If

Ende:

End Sub

Sub FileSave()

On Error GoTo Ende:

'Winword Befehl Speichern

'Zusätzlich Dokumenteigenschaften setzen.

'Setzt die Dokumenteigenschaften des aktiven Dokumentes

Dim strTitel As String

Dim strThema As String

Dim strAutor As String

Dim strManager As String

Dim strKategorie As String

Dim strFirma As String

Dim strDocName As String

Dim strKommentar As String

Dim strHyperlink As String

strDocName = ActiveDocument.Name

strTitel = strDocName

If strTitel = "" Then

'Nichts machen, da Abbrechen gewählt wurde!

Else

strThema = "Dokumentvorlage für VVEV"

strAutor = "Pirmin Steiner"

strManager = "Pirmin Steiner (DO/stp)"

strKategorie = "Winword Dokumentvorlage"

strFirma = "GENERALI Personenversicherungen"

strKommentar = "Erstellt/Geändert am: " & vbCrLf & "Datum: " & Date & vbCrLf & "Zeit: " & Time & vbCrLf & "Durch: DO/stp"

strThema = "Druckvorlage (Winword 2000)"

strHyperlink = "www.generali.ch"

With ActiveDocument

.BuiltInDocumentProperties(wdPropertyTitle) = strTitel

.BuiltInDocumentProperties(wdPropertyAuthor) = strAutor

.BuiltInDocumentProperties(wdPropertyManager) = strManager

.BuiltInDocumentProperties(wdPropertyCategory) = strKategorie

.BuiltInDocumentProperties(wdPropertyCompany) = strFirma

.BuiltInDocumentProperties(wdPropertyComments) = strKommentar

.BuiltInDocumentProperties(wdPropertyHyperlinkBase) = strHyperlink

.BuiltInDocumentProperties(wdPropertySubject) = strThema

End With

ActiveDocument.Save

End If

Ende:

End Sub

Sub FileSaveAs()

On Error GoTo Ende:

'Winword Befehl Speichern unter...

'Zusätzlich Dokumenteigenschaften setzen.

'Setzt die Dokumenteigenschaften des aktiven Dokumentes

Dim strTitel As String

Dim strThema As String

Dim strAutor As String

Dim strManager As String

Dim strKategorie As String

Dim strFirma As String

Dim strDocName As String

Dim strDocFullName As String

Dim strKommentar As String

Dim strHyperlink As String

strDocFullName = ActiveDocument.FullName

' ActiveDocument.SaveAs

'ChDir ActiveDocument.AttachedTemplate.Path

With Dialogs(wdDialogFileSaveAs)

.Name = strDocFullName

.Show

End With

strDocName = ActiveDocument.Name

strTitel = strDocName

If strTitel = "" Then

'Nichts machen, da Abbrechen gewählt wurde!

Else

strThema = "Dokumentvorlage für VVEV"

strAutor = "Pirmin Steiner"

strManager = "Pirmin Steiner (DO/stp)"

strKategorie = "Winword Dokumentvorlage"

strFirma = "GENERALI Personenversicherungen"

strKommentar = "Erstellt/Geändert am: " & vbCrLf & "Datum: " & Date & vbCrLf & "Zeit: " & Time & vbCrLf & "Durch: DO/stp"

strTitel = strDocName

strThema = "Druckvorlage (Winword 2000)"

strHyperlink = "www.generali.ch"

With ActiveDocument

.BuiltInDocumentProperties(wdPropertyTitle) = strTitel

.BuiltInDocumentProperties(wdPropertyAuthor) = strAutor

.BuiltInDocumentProperties(wdPropertyManager) = strManager

.BuiltInDocumentProperties(wdPropertyCategory) = strKategorie

.BuiltInDocumentProperties(wdPropertyCompany) = strFirma

.BuiltInDocumentProperties(wdPropertyHyperlinkBase) = strHyperlink

.BuiltInDocumentProperties(wdPropertySubject) = strThema

.BuiltInDocumentProperties(wdPropertyComments) = strKommentar

End With

ActiveDocument.Save 'Damit die Eigenschaften gespeichert sind.

End If

Ende:

End Sub

' zuletzt geändert von

ActiveDocument.BuiltInDocumentProperties(7) = "Hans Letzter"

1	Title	Mein eigener Titel
2	Subject	Die Dateieigenschaften
3	Author	andreas entenmann
4	Keywords	excel vba
5	Comments	Dies ist mein Kommentar dazu
6	Template
7	Last author	Andreas Entenmann Privat
8	Revision number
9	Application name	Microsoft Excel
10	Last print date	04.08.2004 14:33
11	Creation date	31.07.2004 10:08
12	Last save time	07.08.2004 12:04
13	Total editing time	0
14	Number of pages
15	Number of words
16	Number of characters
17	Security	0
18	Category	VBA
19	Format
20	Manager	DerBoss
21	Company	Privat
22	Number of bytes
23	Number of lines
24	Number of paragraphs
25	Number of slides
26	Number of notes
27	Number of hidden Slides
28	Number of multimedia clips
29	Hyperlink base
30	Number of characters (with spaces)

Dokumenteigenschaften alle

WdBuiltInProperty-Enumeration

'Gibt eine integrierte Dokumenteigenschaft an.

'Name Wert Beschreibung

wdPropertyAppName 9 Name der Anwendung.

wdPropertyAuthor 3 Autor.

wdPropertyBytes 22 Byteanzahl.

wdPropertyCategory 18 Kategorie.

wdPropertyCharacters 16 Zeichenanzahl.

wdPropertyCharsWSpaces 30 Zeichenanzahl mit Leerzeichen.

wdPropertyComments 5 Kommentare.

wdPropertyCompany 21 Firma.

wdPropertyFormat 19 Nicht unterstützt.

wdPropertyHiddenSlides 27 Nicht unterstützt.

wdPropertyHyperlinkBase 29 Nicht unterstützt.

wdPropertyKeywords 4 Schlüsselwörter.

wdPropertyLastAuthor 7 Letzter Autor.

wdPropertyLines 23 Zeilenanzahl.

wdPropertyManager 20 Manager.

wdPropertyMMClips 28 Nicht unterstützt.

wdPropertyNotes 26 Hinweise.

wdPropertyPages 14 Seitenanzahl.

wdPropertyParas 24 Absatzanzahl.

wdPropertyRevision 8 Revisionsnummer.

wdPropertySecurity 17 Sicherheitseinstellung.

wdPropertySlides 25 Nicht unterstützt.

wdPropertySubject 2 Betreff.

wdPropertyTemplate 6 Vorlagename.

wdPropertyTimeCreated 11 Erstellt.

wdPropertyTimeLastPrinted 10 Zuletzt gedruckt.

wdPropertyTimeLastSaved 12 Zuletzt gespeichert.

wdPropertyTitle 1 Titel.

wdPropertyVBATotalEdit 13 Anzahl der Bearbeitungen am VBA-Projekt.

wdPropertyWords 15 Wortanzahl.

Test

Sub TestProperties()

On Error Resume Next

strWDPropertey10 = ActiveDocument.BuiltInDocumentProperties(wdPropertyAppName)

strWDPropertey11 = ActiveDocument.BuiltInDocumentProperties(wdPropertyAuthor)

strWDPropertey12 = ActiveDocument.BuiltInDocumentProperties(wdPropertyBytes)

strWDPropertey13 = ActiveDocument.BuiltInDocumentProperties(wdPropertyCategory)

strWDPropertey14 = ActiveDocument.BuiltInDocumentProperties(wdPropertyCharacters)

strWDPropertey15 = ActiveDocument.BuiltInDocumentProperties(wdPropertyCharsWSpaces)

strWDPropertey16 = ActiveDocument.BuiltInDocumentProperties(wdPropertyComments)

strWDPropertey17 = ActiveDocument.BuiltInDocumentProperties(wdPropertyCompany)

strWDPropertey18 = ActiveDocument.BuiltInDocumentProperties(wdPropertyFormat)

strWDPropertey19 = ActiveDocument.BuiltInDocumentProperties(wdPropertyHiddenSlides)

strWDPropertey20 = ActiveDocument.BuiltInDocumentProperties(wdPropertyHyperlinkBase)

strWDPropertey21 = ActiveDocument.BuiltInDocumentProperties(wdPropertyKeywords)

strWDPropertey22 = ActiveDocument.BuiltInDocumentProperties(wdPropertyLastAuthor)

strWDPropertey23 = ActiveDocument.BuiltInDocumentProperties(wdPropertyLines)

strWDPropertey24 = ActiveDocument.BuiltInDocumentProperties(wdPropertyManager)

strWDPropertey25 = ActiveDocument.BuiltInDocumentProperties(wdPropertyMMClips)

strWDPropertey26 = ActiveDocument.BuiltInDocumentProperties(wdPropertyNotes)

strWDPropertey27 = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)

strWDPropertey28 = ActiveDocument.BuiltInDocumentProperties(wdPropertyParas)

strWDPropertey29 = ActiveDocument.BuiltInDocumentProperties(wdPropertyRevision)

strWDPropertey30 = ActiveDocument.BuiltInDocumentProperties(wdPropertySecurity)

strWDPropertey31 = ActiveDocument.BuiltInDocumentProperties(wdPropertySlides)

strWDPropertey32 = ActiveDocument.BuiltInDocumentProperties(wdPropertySubject)

strWDPropertey33 = ActiveDocument.BuiltInDocumentProperties(wdPropertyTemplate)

strWDPropertey34 = ActiveDocument.BuiltInDocumentProperties(wdPropertyTimeCreated)

strWDPropertey35 = ActiveDocument.BuiltInDocumentProperties(wdPropertyTimeLastPrinted)

strWDPropertey36 = ActiveDocument.BuiltInDocumentProperties(wdPropertyTimeLastSaved)

strWDPropertey37 = ActiveDocument.BuiltInDocumentProperties(wdPropertyTitle)

strWDPropertey38 = ActiveDocument.BuiltInDocumentProperties(wdPropertyVBATotalEdit)

strWDPropertey39 = ActiveDocument.BuiltInDocumentProperties(wdPropertyWords)

MsgBox "strWDPropertey10 = " & strWDPropertey10 & vbCrLf & _

"strWDPropertey11 = " & strWDPropertey11 & vbCrLf & _

"strWDPropertey12 = " & strWDPropertey12 & vbCrLf & _

"strWDPropertey13 = " & strWDPropertey13 & vbCrLf & _

"strWDPropertey14 = " & strWDPropertey14 & vbCrLf & _

"strWDPropertey15 = " & strWDPropertey15 & vbCrLf & _

"strWDPropertey16 = " & strWDPropertey16 & vbCrLf & _

"strWDPropertey17 = " & strWDPropertey17 & vbCrLf & _

"strWDPropertey18 = " & strWDPropertey18 & vbCrLf & _

"strWDPropertey19 = " & strWDPropertey19 & vbCrLf & _

"strWDPropertey20 = " & strWDPropertey20 & vbCrLf & _

"strWDPropertey21 = " & strWDPropertey21 & vbCrLf & _

"strWDPropertey22 = " & strWDPropertey22 & vbCrLf & _

"strWDPropertey23 = " & strWDPropertey23 & vbCrLf & _

"strWDPropertey24 = " & strWDPropertey24

MsgBox "strWDPropertey25 = " & strWDPropertey25 & vbCrLf & _

"strWDPropertey26 = " & strWDPropertey26 & vbCrLf & _

"strWDPropertey27 = " & strWDPropertey27 & vbCrLf & _

"strWDPropertey28 = " & strWDPropertey28 & vbCrLf & _

"strWDPropertey29 = " & strWDPropertey29 & vbCrLf & _

"strWDPropertey30 = " & strWDPropertey30 & vbCrLf & _

"strWDPropertey31 = " & strWDPropertey31 & vbCrLf & _

"strWDPropertey32 = " & strWDPropertey32 & vbCrLf & _

"strWDPropertey33 = " & strWDPropertey33 & vbCrLf & _

"strWDPropertey34 = " & strWDPropertey34 & vbCrLf & _

"strWDPropertey35 = " & strWDPropertey35 & vbCrLf & _

"strWDPropertey36 = " & strWDPropertey36 & vbCrLf & _

"strWDPropertey37 = " & strWDPropertey37 & vbCrLf & _

"strWDPropertey38 = " & strWDPropertey38 & vbCrLf & _

"strWDPropertey39 = " & strWDPropertey39

End Sub

Dokumenteigenschaften mit Loop ausgeben (ActiveDocument.BuiltInDocumentProperties)

'Subroutine ShowBuiltInDocumentProperties loops through the document's BuiltInDocumentProperties collection, displaying the property values in the Debug window.

' Display the active document's built-in properties.

Public Sub ShowBuiltInDocumentProperties()

Dim dp As DocumentProperty

On Error Resume Next

For Each dp In ActiveDocument.BuiltInDocumentProperties

Debug.Print dp.Name & ": ";

Debug.Print dp.Value

If Err.Number <> 0 Then

Debug.Print "??????????"

Err.Clear

End If

Next dp

End Sub

Dokumenteigenschaften auslesen ohne das Dokument zu öffnen

Sub DokumenteigenschaftAuslesenOhneOeffnen()

Dim strDokument As String

strDokument = "C:\Abfall\GO\dlabr4_erfassung_auto_d.dotx"

Set objDatei = GetObject(strDokument)

MsgBox objDatei.BuiltInDocumentProperties.Item(wdPropertyTitle)

' Wieder schliessen im Hintergrund

objDatei.Close False

Set objDatei = Nothing

End Sub

Zum Dokumentbeginn

Benutzerdefinierte Einstellungen erhalten

'Ändern Sie mit Ihren Prozeduren benutzerdefinierte Einstellungen in Word, gehört es zum guten Programmierstil,

'dass Sie sie nach Beendigung Ihrer Operationen wiederherstellen. Dazu müssen Sie sie speichern,

'bevor Sie mit deren Modifikation beginnen.

'Öffnen Sie in einer Prozedur beispielsweise Dokumente und müssen dafür den Ordner ändern, der auf

'der Registerkarte Dateiablage im Dialog Optionen für Dokumente eingestellt ist, speichern Sie

'die aktuelle Einstellung in einer Variablen, um sie nach dem Öffnen aller Dateien, die Sie für

'Ihre Prozedur benötigen, wiederherstellen zu können.

Sub DokumenteÖffnen(strDateiname As String)

Dim strBenutzerordner As String

Dim dlgÖffnen As Dialog

Dim lngButton As Long

On Error GoTo Err_DokumenteÖffnen:

strBenutzerordner = Options.DefaultFilePath(wdDocumentsPath)

Documents.Open FileName:=strBenutzerordner & _

Application.PathSeparator & strDateiname

Exit Sub

Err_DokumenteÖffnen:

If MsgBox("Datei konnte im Ornder " & strBenutzerordner & _

" nicht gefunden werden." & vbCrLf & " Möchten Sie selbst nach der _

Datei suchen?", vbYesNo) = vbYes Then

Set dlgFileOpen = Dialogs(wdDialogFileOpen)

lngButton = dlgFileOpen.Display

strDateiname = dlgFileOpen.Name

If lngButton = -1 Then

Documents.Open FileName:=strDateiname

Options.DefaultFilePath (wdDocumentsPath) = strBenutzerordner

End If

End Sub

Zum Dokumentbeginn

Mehrmaliges Wiederholen

'Word unterstützt das Wiederholen der letzten Aktion. Diese nützliche Funktion, die schnell über die Taste [F4]

'aufgerufen werden kann, lässt sich durch eine ähnliche Funktion ergänzen, nämlich das mehrmalige Wiederholen eines

'Arbeitsschritts. Weisen Sie der Prozdur eine Tastenkombination zu, beziehungsweise fügen Sie eine Schaltfläche auf

'der Symbolleiste ein, ist sie genauso bequem auszuführen wie die eingebaute Funktion.

Sub RepeatLastAction()

Dim dummy as Variant

dummy = InputBox("Anzahl der Wiederholungen", _

"Wiederholen der letzten Aktion:", 10)

If IsNumeric(dummy) Then

dummy=CInt(dummy)

If dummy>0 Then

Application.Repeat (dummy)

End if

End If

End Sub

'Die Prozedur zeigt eine Inputbox an, in die die Zahl der Wiederholungen eingetragen werden kann.

'Als Standardwert gibt die Prozedur den Wert 10 an. Der Wert wird der Methode Repeat als Parameter übergeben.

Zum Dokumentbeginn

Steuerzeichen ersetzen

'Importieren Sie Text in Word oder auch in eine andere Office-Anwendung, kommt es häufig vor, dass er irgendwelche

'Steuerzeichen enthält, die Sie nicht in Ihren Dokumenten haben möchten. Um sie zu löschen, können Sie relativ 'bequem mit dem ASCII-Code arbeiten. Alle Zeichen, die in einem normalen Text vorkommen, liegen nämlich in dem

'Bereich zwischen 32 und 127. Einzige Ausnahmen sind das Absatzzeichen, der Zeilenumbruch und der Tabulator,

'die in der Regel nicht gelöscht werden sollen. Sie haben die ASCII-Codes 13, 10 und 9. Folgende Prozedur

'entfernt alle übrigen Steuerzeichen aus einem Text und ersetzt sie durch ein Leerzeichen:

Sub SteuerzeichenErsetzen()

Dim lngPosition As Long

Dim intZeichen As Integer

While lngPosition < ActiveDocument.Range.End

ActiveDocument.Range(Start:=lngPosition, End:=lngPosition + 1) _

.Select

intZeichen = Asc(Selection.Text)

If (intZeichen < 32 Or intZeichen > 127) And intZeichen <> 13 _

And intZeichen <> 10 And intZeichen <> 9 Then

Selection.Text = " "

End If

lngPosition = lngPosition + 1

Wend

End Sub

Zum Dokumentbeginn

Datei mit fortlaufender Nummer speichern

'Im Ordner wird eine Datei mit dem gleichen Dateinamen und der Endung ini erstellt, wo die Nummer gespeichert wird.

'Wird diese Datei manipuliert, kann es zu Fehlern kommen.

Sub DateiSpeichern()

Dim Nr%

Dim dName$

Dim Zielordner$, Dateiname$

'Hier den Pfad verändern

Zielordner = "c:\eigene dateien\"

'Hier den Dateinamen verändern

Dateiname = "SichWiederholenderText"

dName = Zielordner & Dateiname & ".ini"

On Error Resume Next

Open dName For Input As #1

If Err > 0 Then

Nr = 1

Open dName For Output As #1

Print #1, Nr

Exit Sub

Else

Input #1, Nr

Open dName For Output As #1

Print #1, Nr + 1

End If

ActiveDocument.SaveAs Zielordner & Dateiname & Nr

End Sub

Datei mit fortlaufender Nummer speichern 2

'oder mit Vornullen aufgefüllt:

'Im Ordner wird eine Datei mit dem gleichen Dateinamen und der Endung ini erstellt,

'wo die Nummer gespeichert wird. Wird diese Datei manipuliert, kann es zu Fehlern kommen.

'http://home.datacomm.ch/pirmin.steiner/

Sub DateiMitFortlaufenderNummerSpeichern()

Dim Nr As String

Dim dName$

Dim Zielordner$, Dateiname$

'Hier den Pfad verändern

Zielordner = "C:\TEMP\"

'Hier den Dateinamen verändern

Dateiname = "SichWiederholenderDateiname"

dName = Zielordner & Dateiname & ".ini"

On Error Resume Next

Open dName For Input As #1

If Err > 0 Then

Nr = 1

Open dName For Output As #1

Print #1, Nr

Exit Sub

Else

Input #1, Nr

Open dName For Output As #1

Print #1, Nr + 1

End If

Nr = Format(Nr, "000000000")

ActiveDocument.SaveAs Zielordner & Dateiname & "_" & Nr

End Sub

Zum Dokumentbeginn

Dateieigenschaften auslesen

'Die Routine TestB schreibt alle Dokumenteneigenschaften in das aktive Dokument, Routine TestC schreibt ein

'spezifische Dokumenteneigenschaft (nämlich den Autor) heraus.

Sub TestB()

For i = 1 To 30

With ActiveDocument.BuiltInDocumentProperties(i)

On Error Resume Next

Selection.TypeText _

Text:=i & vbTab & .Name & vbTab & .Value & vbCrLf

On Error GoTo 0

End With

Next i

With ActiveDocument.Content.ParagraphFormat

.TabStops.Add (CentimetersToPoints(1))

.TabStops.Add (CentimetersToPoints(8))

End With

End Sub

Sub TestC()

Selection.TypeText _

Text:=ActiveDocument.BuiltInDocumentProperties("Author").Value

End Sub

Zum Dokumentbeginn

In INI-File schreiben und wieder daraus lesen

Public Sub InILesen()

Dim strVariabel As String ' Dynamisches Datenfeld deklarieren

strVariabel = "vreneli" ' Variabel definieren

'Ins INI-File schreiben

System.PrivateProfileString(FileName:="C:\Eigene Dateien\Makro\Makro.ini", _

Section:="DokMerker", Key:="strVariabel") = strVariabel

End Sub

Public Sub InIEinfügen()

Dim strVariabel As String ' Dynamisches Datenfeld deklarieren

'Vom INI-File lesen

strVariabel = System.PrivateProfileString(FileName:="C:\Eigene Dateien\Makro\Makro.ini", _

Section:="DokMerker", Key:="strVariabel")

Selection.TypeText strVariabel ' Variabel in Text einfügen

Selection.TypeParagraph ' Zeilenumbruch einfügen

End Sub

Zum Dokumentbeginn

Ist eine Datei vorhanden:

Public Sub DateiVorh()

Dim strDateiVorhanden As String

Dim Datei1, Pfad1, Name1

' Liefert "AnsEinst.ini" (in die Variable strDateiVorhanden), falls die Datei existiert.

strDateiVorhanden = Dir("C:\AnsEinst.ini")

End Sub

Oder

Sub Datei_Existenz_Pruefung()

Dim strDateiName As String

Dim strOneDrivePath As String

Dim strDateiExistiert As String

strDateiName = "LetterTemplate.ini"

strOneDrivePath = Environ("OneDriveCommercial") & Application.PathSeparator

' strOneDrivePath = strOneDrivePath

strDateiExistiert = Dir(strOneDrivePath & strDateiName)

If strDateiExistiert = strDateiName Then

MsgBox "Die ausgewählte Datei existiert"

Else

MsgBox "Die ausgewählte Datei existiert nicht"

End If

End Sub

Zum Dokumentbeginn

OptionenAnsicht in ein INI-File schreiben und wieder daraus lesen:

' Erstellt 12.05.2001 Pirmin Steiner

' Damit die User nach Ablauf der Makros wieder ihre eigenen Einstellungen

' haben, habe ich hier ein Makro geschrieben, das die Einstellungen vor

' dem Ablauf der Makros in das InI-File "AnsEinst.ini" im Pfad "C:\"

' schreibt.

' Am Schluss aller Makros werden dann alle Einstellungen wieder zurückgesetzt.

Zum Dokumentbeginn

Public Sub OptionenAnsichtLesen()

Dim blnOptAnsHorizBildl As Boolean

Dim blnOptAnsVertikBildl As Boolean

Dim blnOptAnsLeftScroBar As Boolean

Dim sngOptAnsFormatAnsSeit As Single

Dim blnOptAnsRightRuler As Boolean

Dim blnOptAnsQuikInfo As Boolean

Dim blnOptAnsAnimiText As Boolean

Dim blnOptAnsKonzSchrift As Boolean

Dim blnOptAnsFenstrbrUmbr As Boolean

Dim blnOptAnsPlatzhGrafik As Boolean

Dim blnOptAnsFeldfunkt As Boolean

Dim blnOptAnsTextmarkAnz As Boolean

Dim lngOptAnsFeldSchattier As Long

Dim blnOptAnsTabZeichen As Boolean

Dim blnOptAnsLeerZeichen As Boolean

Dim blnOptAnsAbsatzMarken As Boolean

Dim blnOptAnsBedingtTrennz As Boolean

Dim blnOptAnsAusgblText As Boolean

Dim blnOptAnsAlle As Boolean

Dim blnOptAnsZeichnungen As Boolean

Dim blnOptAnsObjektAnker As Boolean

Dim blnOptAnsTextbegre As Boolean

Dim blnOptAnsHervorhebung As Boolean

Dim blnOptDruckFeldfunkt As Boolean

Dim blnOptDruckVerknAkt As Boolean

Dim blnOptDruckFelderAusdr As Boolean

Dim blnOptDruckAusgeblenTxt As Boolean

Dim blnOptDruckZeichnungsobj As Boolean

Dim blnOptDruckUmgekehrtReih As Boolean

Dim strOptDruckSchachtEinst As String

Dim strOptSpeichDatSpeichUnt As String

Dim strDateiVorhanden As String

'Abfragen ob die Datei "AnsEinst.ini" existiert

Dim Datei1, Pfad1, Name1

'Liefert "AnsEinst.ini" (in die Variable strDateiVorhanden), falls die Datei existiert.

strDateiVorhanden = Dir("C:\AnsEinst.ini")

On Error Resume Next 'Falls mal ein Eintrag im INI-File fehlt.

If strDateiVorhanden = "AnsEinst.ini" Then

'--- Extras Optionen Einstellungen: Ansicht abfragen ---

'Extras Optionen Ansicht 'Horizontale Bildlaufleiste' abfragen

blnOptAnsHorizBildl = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptAnsHorizBildl") 'Vom INI lesen

Options.Application.ActiveWindow.DisplayHorizontalScrollBar = blnOptAnsHorizBildl 'Ausführen

'Extras Optionen Ansicht 'Vertikale Bildlaufleiste' abfragen

blnOptAnsVertikBildl = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptAnsVertikBildl") 'Vom INI lesen

Options.Application.ActiveWindow.DisplayVerticalScrollBar = blnOptAnsVertikBildl 'Ausführen

'Extras Optionen Ansicht ??? abfragen

blnOptAnsLeftScroBar = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptAnsLeftScroBar") 'Vom INI lesen

Options.Application.ActiveWindow.DisplayLeftScrollBar = blnOptAnsLeftScroBar 'Ausführen

'Extras Optionen Ansicht wird links 2 cm die Formatvorlagen der Zeilen angezeigt

sngOptAnsFormatAnsSeit = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="sngOptAnsFormatAnsSeit") 'Vom INI lesen

Options.Application.ActiveWindow.StyleAreaWidth = sngOptAnsFormatAnsSeit 'Ausführen

'Extras Optionen Ansicht hat irgendwie mit der Ansicht zutun

blnOptAnsRightRuler = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptAnsRightRuler") 'Vom INI lesen

Options.Application.ActiveWindow.DisplayRightRuler = blnOptAnsRightRuler 'Ausführen

'Extras Optionen Ansicht 'QuikInfo' abfragen

blnOptAnsQuikInfo = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptAnsQuikInfo") 'Vom INI lesen

Options.Application.ActiveWindow.DisplayScreenTips = blnOptAnsQuikInfo 'Ausführen

'Extras Optionen Ansicht 'Animierter Text' abfragen

blnOptAnsAnimiText = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptAnsAnimiText") 'Vom INI lesen

Options.Application.ActiveWindow.View.ShowAnimation = blnOptAnsAnimiText 'Ausführen

'Extras Optionen Ansicht 'Konzeptschriftart' abfragen

blnOptAnsKonzSchrift = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptAnsKonzSchrift") 'Vom INI lesen

Options.Application.ActiveWindow.View.Draft = blnOptAnsKonzSchrift 'Ausführen

'Extras Optionen Ansicht 'Auf Fensterbreite umbrechen' abfragen

blnOptAnsFenstrbrUmbr = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptAnsFenstrbrUmbr") 'Vom INI lesen

Options.Application.ActiveWindow.View.WrapToWindow = blnOptAnsFenstrbrUmbr 'Ausführen

'Extras Optionen Ansicht 'Platzhalter für Grafiken anzeigen' abfragen

blnOptAnsPlatzhGrafik = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptAnsPlatzhGrafik") 'Vom INI lesen

Options.Application.ActiveWindow.View.ShowPicturePlaceHolders = blnOptAnsPlatzhGrafik 'Ausführen

'Extras Optionen Ansicht 'Feldfunktonen anzeigen' abfragen

blnOptAnsFeldfunkt = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptAnsFeldfunkt") 'Vom INI lesen

Options.Application.ActiveWindow.View.ShowFieldCodes = blnOptAnsFeldfunkt 'Ausführen

'Extras Optionen Ansicht 'Textmarken anzeigen' abfragen

blnOptAnsTextmarkAnz = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptAnsTextmarkAnz") 'Vom INI lesen

Options.Application.ActiveWindow.View.ShowBookmarks = blnOptAnsTextmarkAnz 'Ausführen

'Extras Optionen Ansicht 'Bildschirm-Schattierung für Formularfelder' immer abfragen

lngOptAnsFeldSchattier = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="lngOptAnsFeldSchattier") 'Vom INI lesen

Options.Application.ActiveWindow.View.FieldShading = lngOptAnsFeldSchattier 'Ausführen

'Extras Optionen Ansicht 'Tabstopzeichen' abfragen

blnOptAnsTabZeichen = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptAnsTabZeichen") 'Vom INI lesen

Options.Application.ActiveWindow.View.ShowTabs = blnOptAnsTabZeichen 'Ausführen

'Extras Optionen Ansicht 'Leerzeichen' abfragen

blnOptAnsLeerZeichen = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptAnsLeerZeichen") 'Vom INI lesen

Options.Application.ActiveWindow.View.ShowSpaces = blnOptAnsLeerZeichen 'Ausführen

'Extras Optionen Ansicht 'Absatzmarken' abfragen

blnOptAnsAbsatzMarken = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptAnsAbsatzMarken") 'Vom INI lesen

Options.Application.ActiveWindow.View.ShowParagraphs = blnOptAnsAbsatzMarken 'Ausführen

'Extras Optionen Ansicht 'Bedingte Trennzeichen' abfragen

blnOptAnsBedingtTrennz = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptAnsBedingtTrennz") 'Vom INI lesen

Options.Application.ActiveWindow.View.ShowHyphens = blnOptAnsBedingtTrennz 'Ausführen

'Extras Optionen Ansicht 'Ausgeblendeten Text' abfragen

blnOptAnsAusgblText = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptAnsAusgblText") 'Vom INI lesen

Options.Application.ActiveWindow.View.ShowHiddenText = blnOptAnsAusgblText 'Ausführen

'Extras Optionen Ansicht 'ALLE' abfragen

blnOptAnsAlle = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptAnsAlle") 'Vom INI lesen

Options.Application.ActiveWindow.View.ShowAll = blnOptAnsAlle 'Ausführen

'Extras Optionen Ansicht 'Zeichnungen' abfragen

blnOptAnsZeichnungen = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptAnsZeichnungen") 'Vom INI lesen

Options.Application.ActiveWindow.View.ShowDrawings = blnOptAnsZeichnungen 'Ausführen

'Extras Optionen Ansicht 'Objektanker' abfragen

blnOptAnsObjektAnker = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptAnsObjektAnker") 'Vom INI lesen

Options.Application.ActiveWindow.View.ShowObjectAnchors = blnOptAnsObjektAnker 'Ausführen

'Extras Optionen Ansicht 'Textbegrenzungen' abfragen

blnOptAnsTextbegre = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptAnsTextbegre") 'Vom INI lesen

Options.Application.ActiveWindow.View.ShowTextBoundaries = blnOptAnsTextbegre 'Ausführen

'Extras Optionen Ansicht 'Hervorhebungen' abfragen

blnOptAnsHervorhebung = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptAnsHervorhebung") 'Vom INI lesen

Options.Application.ActiveWindow.View.ShowHighlight = blnOptAnsHervorhebung 'Ausführen

'--- Extras Optionen Einstellungen: Drucken abfragen ---

'Extras Optionen Drucken 'Felder aktualisieren' abfragen

blnOptDruckFeldfunkt = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptDruckFeldfunkt") 'Vom INI lesen

Options.UpdateFieldsAtPrint = blnOptDruckFeldfunkt 'Ausführen

'Extras Optionen Drucken 'Verknüpfungen aktualisieren' abfragen

blnOptDruckVerknAkt = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptDruckVerknAkt") 'Vom INI lesen

Options.UpdateFieldsAtPrint = blnOptDruckVerknAkt 'Ausführen

'Extras Optionen Drucken 'Feldfunktionen drucken' abfragen

blnOptDruckFelderAusdr = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptDruckFelderAusdr") 'Vom INI lesen

Options.UpdateFieldsAtPrint = blnOptDruckFelderAusdr 'Ausführen

'Extras Optionen Drucken 'Ausgeblendeter Text drucken' abfragen

blnOptDruckAusgeblenTxt = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptDruckAusgeblenTxt") 'Vom INI lesen

Options.UpdateFieldsAtPrint = blnOptDruckAusgeblenTxt 'Ausführen

'Extras Optionen Drucken 'Zeichnungsobjekte drucken' abfragen

blnOptDruckZeichnungsobj = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptDruckZeichnungsobj") 'Vom INI lesen

Options.UpdateFieldsAtPrint = blnOptDruckZeichnungsobj 'Ausführen

'Extras Optionen Drucken 'Drucken umgekehrter Reihenfolge' abfragen

blnOptDruckUmgekehrtReih = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="blnOptDruckUmgekehrtReih") 'Vom INI lesen

Options.UpdateFieldsAtPrint = blnOptDruckUmgekehrtReih 'Ausführen

'Extras Optionen Drucken 'Standardschacht' abfragen

strOptDruckSchachtEinst = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="strOptDruckSchachtEinst") 'Vom INI lesen

Options.DefaultTray = strOptDruckSchachtEinst 'Ausführen

'--- Extras Optionen Einstellungen: abfragen ---

'Optionen Speichern 'Word-Dateien speichern unter' abfragen

strOptSpeichDatSpeichUnt = System.PrivateProfileString(FileName:="C:\AnsEinst.ini", _

Section:="WordAnsichtEinstellung", Key:="strOptSpeichDatSpeichUnt") 'Vom INI lesen

Options.Application.DefaultSaveFormat = strOptSpeichDatSpeichUnt 'Ausführen

End If

End Sub

Zum Dokumentbeginn

Public Sub OptionenAnsichtSchreiben()

Dim blnOptAnsHorizBildl As Boolean

Dim blnOptAnsVertikBildl As Boolean

Dim blnOptAnsLeftScroBar As Boolean

Dim sngOptAnsFormatAnsSeit As Single

Dim blnOptAnsRightRuler As Boolean

Dim blnOptAnsQuikInfo As Boolean

Dim blnOptAnsAnimiText As Boolean

Dim blnOptAnsKonzSchrift As Boolean

Dim blnOptAnsFenstrbrUmbr As Boolean

Dim blnOptAnsPlatzhGrafik As Boolean

Dim blnOptAnsFeldfunkt As Boolean

Dim blnOptAnsTextmarkAnz As Boolean

Dim lngOptAnsFeldSchattier As Long

Dim blnOptAnsTabZeichen As Boolean

Dim blnOptAnsLeerZeichen As Boolean

Dim blnOptAnsAbsatzMarken As Boolean

Dim blnOptAnsBedingtTrennz As Boolean

Dim blnOptAnsAusgblText As Boolean

Dim blnOptAnsAlle As Boolean

Dim blnOptAnsZeichnungen As Boolean

Dim blnOptAnsObjektAnker As Boolean

Dim blnOptAnsTextbegre As Boolean

Dim blnOptAnsHervorhebung As Boolean

Dim blnOptDruckFeldfunkt As Boolean

Dim blnOptDruckVerknAkt As Boolean

Dim blnOptDruckFelderAusdr As Boolean

Dim blnOptDruckAusgeblenTxt As Boolean

Dim blnOptDruckZeichnungsobj As Boolean

Dim blnOptDruckUmgekehrtReih As Boolean

Dim strOptDruckSchachtEinst As String

Dim strOptSpeichDatSpeichUnt As String

On Error Resume Next 'Falls mal ein Eintrag im Word fehlt.

'--- Extras Optionen Einstellungen: Ansicht ins INI schreiben ---

'Extras Optionen Ansicht 'Horizontale Bildlaufleiste' abfragen

blnOptAnsHorizBildl = Options.Application.ActiveWindow.DisplayHorizontalScrollBar