VBA Nachschlagewerk Pirmin Steiner

Visual Basic 6 (VBA) Nachschlagewerk Pirmin Steiner

Basierend auf Winword 2000, 2010 und 2016

Autor: Pirmin Steiner

Aktualisiert: 20. November 2020

Inhaltsverzeichnis:

Variablen definieren:

Diverse Einzeiler:

Dokument schliessen ohne Speichern:

Dokument drucken und schliessen ohne Speichern:

Autotextdialog anzeigen

Makrodialogbox anzeigen:

Textmarkendialogbox anzeigen:

Markierter Text aus Dokument in MsgBox ausgeben (markierung):

Markierung von Textmarke zu Textmarke:

InputBox

Speichern unter anzeigen:

Organisierendialogbox anzeigen:

Text suchen und wenn gefunden MsgBox anzeigen:

Textteil aus Variable lesen und verändern

Ist die Textmarke vorhanden, dann auf diese springen:

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

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

Beispiel Dokument suchen:

Alle Textmarken in eine Variable speichern:

Tabelleninhalte lesen und in Variable speichern:

Vergleichen von zwei Variablen:

Zählerschlaufe

Bedingungsschleife

Bedingungsschleife 2 Bedingung am Schluss der Schlaufe

MousOver

Feststellen auf welcher Seite der Cursor sich befindet.

Dokumenteigenschaften setzen

Dokumenteigenschaften alle

Dokumenteigenschaften mit Loop ausgeben (ActiveDocument.BuiltInDocumentProperties)

Dokumenteigenschaften auslesen ohne das Dokument zu öffnen

Benutzerdefinierte Einstellungen erhalten

Mehrmaliges Wiederholen

Steuerzeichen ersetzen

Datei mit fortlaufender Nummer speichern

Datei mit fortlaufender Nummer speichern 2

Dateieigenschaften auslesen

In INI-File schreiben und wieder daraus lesen

Ist eine Datei vorhanden:

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

Public Sub OptionenAnsichtLesen()

Public Sub OptionenAnsichtSchreiben()

Public Sub OptionenAnsichtEinstellung()

Im Add-Ins überprüfen ob das generali.dot installiert ist.

Makro aus Makro ausführen.

Text gespiegelt wiedergeben

Suchen ob es das Wort im Dokument gibt

Abfragen ob eine Frage mit Ja oder nein beantwortet wurde.

Subrutine aus einer Prozedur aufrufen.

Word Assistent aufrufen mit Text

Default Printer einstellen und abrufen:

Textmarkeninhalt auswerten

AddIns anhängen und abhängen

Add Ins Anzeigen

Anhängen und oder Abhängen der AddIn

Ein Programm starten

Fensteransichten bei Word

Auf welcher Seite steht der Coursor

Seitennummer in Variable

Beginn Seite X

Makro nach einer Gewissen Zeit laufen lassen

Ist ein Dokument im Word offen?

Fenster nach Namen Aktivieren

Ist die Seitenvorschau aktiv?

DokumentNamen / oder Variable auf count Anzahl erweitern

Dateien in einem Ordner alle Löschen

Installierte Schriftarten

Windows Tips holen in eine Variable

Ist eine Textmarke vorhanden

Office Assistent Sichtbar und Animieren

Word Ausblenden oder Einblenden

Datum Rechnen

Datumsformat definieren

Zufalls Zahl generieren

Dateien suchen und auflisten

Ein Teil von einer Variable abfragen (Left, Mid, Right)

Len(Feldname)

Ein Dialogbox nur 9 Sekunden anzeigen

UserForm nur eine gewisse Zeit am Bildschirm anzeigen

Beginn- und Endpunkt definieren u. ohne Markieren formatieren

Inhalt einer Textmarke ausgeben

Textmarken Inhalt in eine Variable füllen, mit Zähler

Textmarken im Dokument zählen

Autotext Name und Inhalt ausgeben einer Druckvorlage

AutoText einfügen 1:

AutoText einfügen 2:

Suchen Ersetzten im ganzen Dokument 1

Suchen Ersetzten im ganzen Dokument 2

Variable für andere Prozeduren und Module mit dem Inhalt verfügbar machen

Formatvorlage abfragen welche

Formatvorlagen kopieren

Mit Loop alle Autotexte ausgeben

Abhängen der Sprachabhängigen Autotextvorlage nach dem Editieren

Alle Verwendeten Formatvorlagen

Alle Formatvorlagen in einem Dokument

Tabulatoren löschen und neue setzten

Abfragen Seitenrand und neu setzen

If X = Wert1 oder Wert2

Suchen Ersetzen mit Hochkomma "

Textmarke: Empty-Eigenschaft

Sub DatumZeitSeparat()

Normal.dot saven

Fenster "Alle Fenster in der Taskbar anzeigen" umschalten

Word Warnungen ausgeschalte und wieder einschalten

Briefdatum auf den Briefen mit x Tagen erhöhen

Die 2 letzten Editierten Dokumentnamen in einer ini-Datei ablegen

~Dateien der Add-Ins von Word löschen

Alle Hyperlinks in einem Dokument entfernen

Hyperlink in Variable laden und bearbeiten

CreateTextFile-Methode

Macro-Eigenschaft

Alle Projektnamen ermitteln

Projektnamen ermitteln und setzen

Makro ändert Makro

Variable abfragen ob diese einen bestimmten Wert enthält

Textteil in Variable finden

Neue Formatvorlage basieren auf der vorherigen erstellen

AutoText direkt einfügen

Ist ein Autotext im Dokument vorhanden?

MsgBox definiert ausgeben

AutoText in aktive Dokumentvolage aufnehmen

AutoText aus eignem Template ausgeben

Aus einem Sting die einzelnen Werte auslesen

Prüfen ob ein Ordner existiert

Prüfen ob ein Ordner vorhanden ist und ob er leer ist oder nicht

Ordner erstellen, wenn dieser nicht schon vorhanden ist

Liefert den Pfadseparator vom Pfad (z.B. / oder \)

Vertikales und Horizontales Lineal im Winword wieder anzeigen lassen

Nummerisch oder handelt es sich um ein Datum

Datei ohne Extension (z.B. .doc oder .dot) in eine Variable packen InStr-Funktion

InStrRev-Funktion

Dateiendung einer Datei ermitteln

Dateiname aus Pfad ermitteln

Angemeldeter User ermitteln

Active Directory Informationen des angemeldeten Benutzers lesen

Warteschlaufe einbauen

Datei Move / Datei verschieben

Cursor-Eigenschaft

Welche Position hat eine Textmarke (Nummerierung nach Position im Dokument)

Abfragen ob ein Laufwerk besteht

Wörter suchen (Rückgabe die Anzahl wieviel mal das gesuchte Wort vorkommt)

Zeichen aus Inhalt einer Veriable entfernen

Textmarken neu füllen und dabei erhalten

Feldfunktion lesbar darstellen

Sprache abfragen

Fenster händling

Fensterhändling 2

Aus einem String letztes Zeichen enfernen und TM mit neuem Inhalt wieder setzen

Text aus Variablen-Inhalt entfernen

Word Hidden (unsichtbar) setzen und wieder aufheben

WordPositionAendern (Alle Fenster gleich anordnen in Position Normal)

Sprache der Installierten Office Version abfragen und auch sonstig.

Link aufrufen, je nach Sprache.

Diverse Infos über PC und User ... alles was in Dos-Eingabeaufforderung unter Set aufgeführt ist.

Alle Vorlagen in einem Verzeichnis von .dot in .dotx abspeichern

Dateiendung ermitteln

ZeitMessung

Pfad zu Dateiname in Fenstertitel von Word anzeigen

Module löschen

Modul Importieren

Verweise des aktuellen Projektes ermitteln

Ist ein Modul Vorhanden / Löschen / Importieren / Umbenennen

Modul Umbenennen

Modul Importieren

Modul Exportieren

Datei Suchen und Anzahl der Seiten auflisten und zusammenzählen

Code für Dokumente in einem Verzeichnis alle bearbeiten

Formatvorlage Kopieren 2010

Kopfzeilen und Fusszeilen löschen

Alle Felder in Kopfzeilen und Fusszeilen Aktualisieren

Felder Sperren und wieder Freigeben (Feldsperre)

Abfragen ob Felder im Dokument gesperrt sind

Autotext aus aktivem Template löschen

Text suchen und markieren im Dokument

Feldfunktion welche in Textmarke eingepackt ist. Update / Unlink

Abfrage ob das Dokument schon mit der letzten Änderung gespeichert wurde

Datum Zeit in Zahl darstellen

Dokumente von der RecentFiles-Auflistung öffnen

Feststellen, ob ein Dokument geöffnet ist

Nur die 2 letzten Dokumente im ini-File ablegen

SendWindowMessage

Löschen von Dateien welche Schreibgeschützt, Verseteckt unw. sind

Registry ändern für im Explorer alle Dateien anzeigen

Öffent den Pfad des aktuellen Files und markiert das betroffene File

Liestet alle Zeichen des CHR() auf

Auf ganzem Verzeichnis alle Druckvorlagen den Drucker Einzugs-Schacht mittels TM festlegen

Auf ganzem Verzeichnis alle Druckvorlagen mit einem anderen Drucker Einzugs-Schacht versehen

Text in MsgBox rechts ausrichten

Betriebssystem Bit abfragen

Betriebssystem abfragen

Registry Eintraege Aendern

Ausgeblendeter Text Erkennen

Dataset (Daten in einer Variable in einzelne Teile aufteilen)

Dataset (Daten aus String und Unterstring in einzelne Teile aufteilen)

Dataset, Anzahl Strings

Wieviel Zeichen Hat der String

Alle Drucker auslesen (nicht getestet)

Ganzes Dokument in Range nehmen

Offenes Dokument in E-Mail setzen inkl. Empfänger

Verweise auflisten

Datum oder Zahl prüfen ob diese grösser oder kleiner ist 'iif' (Ergebnis in Variable)

Verweise im Projekt hinzufügen

Modul in Normal.dotm importieren

Modul von einer anderen Vorlage ins Normal.dotm kopieren

Abfragen ob die Variable eine Zahl oder Datum enthält

Einzelne Zeichen eines Strings ersetzen

Inhalt einer Textdatei in eine Variable speichern

Absatzmarke in markiertem Text ersetzen

Text aus TXT-Dateien in einem Dokument auflisten

Suchen Ersetzen in Fusszeilen

Wörter Zählen in einem Dokument

Wörter Zählen von einer Markierung im Dokument

Texdatei Erstellen und etwas reinschreiben

Dokumente in den Formaten .doc, .docx, .docm erstellen

Das Datum -1 Tagen rechnen

Word Datei als PDF-Datei abspeichern

Funktion aufrufen und Variablenwerte mitgeben

Datum in Longdatum umwandeln nach Sprache

Monatsende ermitteln

Quartal ermitteln

Anzahl Wochen im Jahr mit VBA errechnen

Anzal Wochen seit einem Datum ermitteln (DateDiff-Funktion)

SonderZeichen Entfernen

Datei kopieren auch wenn sie geöffnet ist

Zwischenablage löschen

Excel Mehrere Zellen markieren mittels Wert in Variable

Dateien von einem Verzeichnis verarbeiten

Dateien in einem Verzeichnis sortieren, Liste erstellen, und wenn gewünscht ausdrucken

Add-In in "Dokumentvorlagen und Add-Ins" suchen und wenn vorhanden löschen

Datei Atributte ändern

Wörter und Zeichen vom Dokument zählen

ZeichenZaehlen Absatzmarken zählen

Dateiname aus einem Pfad extrahieren

Feldfunktion in VBA erstellen (Fields.Add-Methode)

Nicht verwendete Formatvorlagen im Dokument löschen

Namen der benutzerdefinierten Formatvorlagen im Direktfenster ausgeben.

Anzahl Worte im Dokumente auflisten und Erstes Wort im Dokument wie viele mal es im Dokument vorkommt auflisten

Dokument als Objekt deklarieren

Eine neue Datei erstellen

Umgebungsvariablen

On Resume Next wieder aufheben

Dokumentvariable in einem Dokument definieren

Langes Datum in den verschiedenen Sprachen anhand kurzem Datum erstellen

Abfragen der Speicherorte für Dateien

Alle AutoTexte in ein Array lesen

E-Mail automatisch senden

Langes Briefdatum (1er janvier 2019)

Fomratierungen von Variablen

Projektname des aktuellen Dokuments ermitteln

Anzahl Modulen im Aktiven Dokument zählen

Ganze Ordner und Unterordner kopieren

Nur Folder kopieren

Add-Ins auflisten welche nicht aktiviert sind

Alle Add-Ins unistallieren / deaktivieren

MsgBox in den Vordergrund hohlen vbSystemModal

Bestimmter AutoText aus Normal.dotm abrufen und wenn vorhanden einfügen

Alle Dateien (Fiels) von einem bestimmten Typ in ein anderes Verzeichnis verschieben

Zahlen Formatieren inkl. Funktionsaufruf der Formatierungsdefinition

Vordefinierte Zahlformate

Variablen definieren:

Public strSprache As String ' Variable für das ganze Projekt festlegen, mit Inhalt

Dim strMarks () As String ' Dynamisches Datenfeld deklarieren

Dim strDokname As String ' Dynamisches Datenfeld deklarieren

Dim intZähler As Integer ' Dynamisches Datenfeld für Zähler deklarieren

ReDim Preserve strDateien(intZaehler) ' ReDim dynamisch erweitern. Steht vor dem Abfüllen

der Variable

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

Dokument schliessen ohne Speichern:

Sub Makro9()

' Makro9 Makro

' Makro aufgezeichnet am 6. April 2001 von Steiner Pirmin

' 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

Autotextdialog anzeigen

Sub AutotextAnzeigen()

' Dieses Makro listet das Dialogfeld der Autotexte auf.

Dialogs(wdDialogToolsAutoManager).Show

End Sub

Makrodialogbox anzeigen:

Sub MakroAufstellungB()

' MakroAufstellung Makro

' Makro aufgezeichnet am 9. April 2001 von Steiner Pirmin

' WICHTIG WICHTIG

' Dieses Makro listet das Dialogfeld der Makros auf.

Dialogs(wdDialogToolsMacro).Show

End Sub

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

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

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

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

Speichern unter anzeigen:

Sub SpeichernUnter()

With Dialogs(wdDialogFileSaveAs)

.Name = ""

.Show

End With

End Sub

Organisierendialogbox anzeigen:

Sub Organisieren()

With Dialogs(wdDialogOrganizer)

.Name = ""

.Show

End With

End Sub

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

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

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

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

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

ReDim strMarksVork(1000) ' Größe 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

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

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 anschließend der Pfad und der Name angezeigt. Die Liste der zurückgegebenen Dateien wird außerdem 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

Alle Textmarken in eine Variable speichern:

Sub TextmarkenSuche()

' Makro1 Makro

' Makro aufgezeichnet am 13. April 2001 von Steiner Pirmin

' 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

Tabelleninhalte lesen und in Variable speichern:

Sub Makro11()

' Makro aufgezeichnet am 29. April 2001 von Steiner Pirmin

' 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öße 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

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

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

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

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

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

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

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 stoßen 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

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

Benutzerdefinierte Einstellungen erhalten

Ändern Sie mit Ihren Prozeduren benutzerdefinierte Einstellungen in Word, gehört es zum guten Programmierstil, daß 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

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.

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

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

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

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

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

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.

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

'Wahr, wenn das vertikale Lineal auf der rechten Seite des Dokumentfensters in der Drucklayoutansicht angezeigt wird.

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

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