Zuletzt aktualisiert am 25. Dezember 2023 von Lars
Eine Reihe nach
Textausgabe - Range-Objekt
ActiveDocument.Range.Paragraphs.Count
Liefert Anzahl der Absätze in einem Dokument
Set rng = ActiveDocument.Paragraphs(3).Range With rng .InsertBefore "Neuer Absatz." End With
Gibt vor Absatz 3 Text aus
InsertAfter
Fügt den angegebenen Text am Ende eines Bereichs oder einer Markierung ein.
Nach Anwendung dieser Methode wird der Bereich oder die Markierung erweitert,
damit der neue Text einbezogen wird.
InsertParagraphBefore
Fügt einen neuen Absatz vor der angegebenen Auswahl oder dem Bereich ein.
InsertParagraph
Ersetzt den angegebenen Bereich oder die angegebene Markierung durch einen
neuen Absatz.
InsertSymbol
Fügt ein Symbol an der Stelle des angegebenen Bereichs oder der angegebenen
Markierung ein.
InsertParagraphBefore, InsertParagraphAfter
Fügt einen neuen Absatz vor bzw. nach der angegebenen Auswahl oder dem
Bereich ein.
Dim rng As Range Set rng = ActiveDocument.Paragraphs(3).Range With ActiveDocument.Paragraphs.Last.Range .InsertParagraphAfter .InsertAfter "Neuer Absatz." End With
Beispiel: Ausgabe von drei Textzeilen
Selection.TypeText Text:="Zeile1" Selection.TypeParagraph Selection.TypeText Text:="Zeile2" Selection.TypeParagraph Selection.TypeText Text:="Zeile3" Selection.TypeParagraph
Text formatieren
Sub FormatText() ' ' Aktuelle Selection mit spezieller Laufweite formatieren '
With Selection.Font.Name = "Arial" .Size = 11 .Bold = False .Italic = False .Underline = wdUnderlineNone .UnderlineColor = wdColorAutomatic .StrikeThrough = False .DoubleStrikeThrough = False .Outline = False .Emboss = False .Shadow = False .Hidden = False .SmallCaps = False .AllCaps = False .Color = wdColorBlack .Engrave = False .Superscript = False .Subscript = False .Spacing = 2 .Scaling = 100 .Position = 0 .Kerning = 0 .Animation = wdAnimationNone
End With End Sub
Umgang mit Seiten
Gehe zu Seite 2
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="2"
Anzahl der Seiten feststellen
Function NumberOfPage() As Integer ' ' Anzahl der Seiten zurückgeben ' Dim i As Integer Selection.EndKey Unit:=wdStory i = Selection.Information(wdActiveEndPageNumber) NumberOfPage = i End Function
VB Skript aufrufen
VB-Objekte
Dim fs as Object Set fs = CreateObject("Scripting.FileSystemObject") If fs.FolderExists("C:WIINDOWS") Then MsgBox "Ordner existiert" Else MsgBox "Ordner existiert nicht" End If
fs.CopyFolder "d:dokumente","e:"
UserForm
Modal
Wenn ein UserForm gebunden ist, sollte der Benutzer Informationen liefern oder das UserForm schließen, bevor irgendein Teil der Anwendung verwendet wird. Es wird kein nachfolgender Code ausgeführt, bis das UserForm verborgen oder entladen ist. Obwohl andere Formulare in der Anwendung deaktiviert werden, wenn ein UserForm angezeigt wird, geschieht dies nicht bei anderen Anwendungen.
Wenn das UserForm ungebunden ist, kann der Benutzer andere Formulare oder Fenster anzeigen, ohne das UserForm zu schließen.
Ungebundene Formulare werden nicht in der Taskleiste angezeigt und befinden sich nicht in der Aktivierreihenfolge des Fensters.
Ein Excel-Sheet ohne Excel aufrufen - Hierzu in eine UserForm das Excel-Objekt hinzufügen.
Private Sub Spreadsheet1_BeforeCommand(ByVal EventInfo As OWC.SpreadsheetEventInfo) With EventInfo If .Command = ssClear Then MsgBox "Nichts löschen" .ReturnValue = False End If End With End Sub
Private Sub CoFill_Click() Dim i As Integer For i = 1 To 10 Spreadsheet1.ActiveSheet.Range("C" & Trim(Str(i))) = i Next i End Sub
Sub EinfügenNurText() Selection.PasteSpecial DataType:=wdPasteText End Sub
Sub EinfügenNurText() On Error GoTo EinfFehler Selection.PasteSpecial DataType:=wdPasteText Exit Sub EinfFehler: If Err.Number = 4605 Then MsgBox "Die Zwischenablage ist leer" ElseIf Err.Number = 5342 Then MsgBox "Kein Text in der Zwischenablage" Else 'Für alle Fälle ... Err.Raise Err.Number, Err.Source End If End Sub
Die Makro-Module können auch in eine separate Vorlage gespeichert und in den Autostart-Ordner abgespeichert werden. Zum Bearbeiten muss diese Dokumentvorlage jeweils geöffnet werden
Aufruf des Makro-Editor Alt + F11
Eine spezielle Symbolleiste erstellen
Sub MakeSym() ' ' Symbolleiste erstellen ' Dim cbNewBar As CommandBar Dim ctlBtn As CommandBarButton If Not SymVorhanden("Makros") Then Set cbNewBar = CommandBars.Add(Name:="Makros") With cbNewBar Set ctlBtn = .Controls.Add With ctlBtn .Caption = "111" .Style = msoButtonCaption .OnAction = "111" .BeginGroup = True End With Set ctlBtn = .Controls.Add
End With .Protection = msoBarNoCustomize .Position = msoBarTop .Visible = True End With End If End Sub Private Function SymVorhanden(strMenuName As String) As Boolean ' ' Prüfen, ob Symbolleiste vorhanden ' On Error GoTo ERRORHANDLER Dim cbNewBar As CommandBar Set cbNewBar = Application.CommandBars("Makros") SymVorhanden = True Exit Function ERRORHANDLER: SymVorhanden = False End Function
Eine spezielle Menuleiste erstellen
Sub MakeMenu() ' ' Check ob Menu existiert ' Dim objmenu As CommandBarControl Dim objBefehl As CommandBarButton If MenuVorhanden("&Makros") = False Then Set objmenu = CommandBars("Menu Bar").Controls.Add(Type:=msoControlPopup, Before:=10) With objmenu .Caption = "&Makros"
'1. Befehl anlegen Set objBefehl = .Controls.Add(Type:=msoControlButton) With objBefehl .Caption = "&111" .Style = msoButtonIconAndCaption .OnAction = "111" End With
2. Befehl anlegen Set objBefehl = .Controls.Add(Type:=msoControlButton) With objBefehl :
End With End With
End If End Sub Private Function MenuVorhanden(strMenuName As String) As Boolean Dim objmenu As Object For Each objmenu In CommandBars("Menu Bar").Controls If objmenu.Caption = strMenuName Then MenuVorhanden = True End If Next End Function
Variablen und Konstanten
'Globale Variablen 'Public .. as ... 'Globale Konstanten Public Const StrLogonBytec As String = "lschlageter@freicon.de" Public Const sss As String = "..."
An das Ende eines Word-Dokumentes springen, 3 Zeilen löschen und einen Text einfügen
Sub NachPos() ' ' nachposls Makro ' Makro aufgezeichnet am 21.09.2004 von lschlageter ' Selection.EndKey Unit:=wdStory Selection.TypeBackspace Selection.TypeBackspace Selection.TypeBackspace ChangeFileOpenDirectory "D:Wordvorlagen" Selection.InsertFile FileName:="nachposls2.doc", Range:="", _ ConfirmConversions:=False, Link:=False, Attachment:=False End Sub
Sub URL() ' ' URL aufrufen und einen String in die Zwischenablage aufnehmen ' Dim AnwID Dim Mydata AnwID = Shell("c:programmeintern~1iexplore.exe http://www.lars-web.com/", 1) Set Mydata = New DataObject Mydata.SetText StrLogonBytec Mydata.PutInClipboard End Sub
Sub Logo() ' ' Grafik und Text in die Kopfzeile der ersten Seite einfügen ' Dim rng As Range 'In die Seitenansicht wechseln If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow.ActivePane.View.Type = wdOutlineView Then ActiveWindow.ActivePane.View.Type = wdPrintView End If 'In die Kopfzeile wechseln ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader 'Grafik einfügen Selection.InlineShapes.AddPicture FileName:= "D:Wordvorlagenlogo.jpg", LinkToFile:=False, SaveWithDocument:=True Selection.ParagraphFormat.Alignment = wdAlignParagraphRight Selection.TypeParagraph ' Neuer Absatz 'Text einfügen Selection.Text = "LogoUnterschrift" FormatText Selection.ParagraphFormat.Alignment = wdAlignParagraphRight 'Rechts formatieren ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument End Sub
Hallo, hier schreibt Lars. Dipl-Ing. Ingenieurinformatik (FH). Seit Jahrzehnten in der IT tätig. Geprüfter (und begeisterter) Webmaster. Ebenso begeisterter Windows-, Apple-, und Office-User. Ich schreibe über alle möglichen Themen rund um IT. Mehr über mich erfährst du hier: Über mich. Danke für deinen Besuch!