VBA-Makros für Word

VBA-Makros für Word: Diverse Makros
Automation von Word Sub AutoExec() Diverse Beispiele:
beim Start On Error Resume Next
Application.ActiveWindow.DisplayHorizontalScrollBar = False Keine horizontale Leiste anzeigen.
Application.ActiveDocument.ActiveWindow.Caption = _ Zeigt kompletten Verzeichnispfad in
ActiveDocument.FullName Titelleiste an (nicht Excel!)
Application.Dialogs(wdDialogFileOpen).Show Zeigt das Öffnen-Dialogfeld beim Laden.
Application.ActiveDocument.ActiveWindow.Caption = Now Zeigt Datum und Zeit an.
  End Sub  
Symbolleiste nicht anzeigen Sub Document_Open()
Application.CommandBars("Outlining").Visible = False Nicht benötigte Symbolleiste beim Start
  End Sub verschwinden lassen.
Horizontale Scrollbar Sub KeineHorizontaleLeiste()
entfernen On Error Resume Next
ActiveWindow.DisplayHorizontalScrollBar = False
  End Sub  
Hyperlinks entfernen Sub NoHyperlinks()
'On Error Resume Next
Dim x As Variant
For Each x In ActiveDocument.Hyperlinks
Selection.WholeStory
Selection.Range.Hyperlinks(1).Delete
Next x
  End Sub  
Schrift Arial 8punkt Sub SchriftArial8_Absatz0pt()
Absatz Null On Error Resume Next
With Selection.Font
.Name = "Arial"
.Size = 8 Schriftgröße.
End With
With Selection.ParagraphFormat
.LeftIndent = CentimetersToPoints(0.1)
.SpaceAfter = 0 Bei Absatz 2punkt steht hier der Wert 2.
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = True
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = CentimetersToPoints(0)
.OutlineLevel = wdOutlineLevelBodyText
End With
  End Sub  
Schrift Arial 8punkt Absatz 2 Sub SchriftArial8_Absatz2pt()
On Error Resume Next
With Selection.Font
.Name = "Arial"
.Size = 8 Schriftgröße.
End With
With Selection.ParagraphFormat
.LeftIndent = CentimetersToPoints(0.1)
.SpaceAfter = 2 Bei Absatz 0punkt steht hier der Wert 0.
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = True
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = CentimetersToPoints(0)
.OutlineLevel = wdOutlineLevelBodyText
End With
  End Sub  
Schrift Arial 10punkt Absatz 2 Sub SchriftArial10_Absatz2pt()
On Error Resume Next
With Selection.Font
.Name = "Arial"
.Size = 10 Schriftgröße.
End With
With Selection.ParagraphFormat
.LeftIndent = CentimetersToPoints(0.1)
.SpaceAfter = 2
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = True
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = CentimetersToPoints(0)
.OutlineLevel = wdOutlineLevelBodyText
End With
  End Sub  
Spiegeltext erzeugen bzw. Sub Spiegeltext()
rückgängig machen On Error Resume Next
Dim Text As String
Dim Neutext As String
Dim Anzahl As Integer
Dim i As Integer
Dim Lauf() As String
Neutext = ""
Text = Selection
Anzahl = Len(Text)
ReDim Lauf(Anzahl + 1)
For i = 1 To Anzahl
Lauf(i) = Mid(Text, i, 1)
Next
For i = Anzahl To 1 Step -1
Neutext = Neutext & Lauf(i)
Next
Selection = Neutext
  End Sub  
Tabellen gleichmäßig Sub TabelleFormatieren()
formatieren On Error Resume Next
With Selection.Tables(1)
With .Borders(wdBorderLeft)
.LineStyle = wdLineStyleDot
.LineWidth = wdLineWidth025pt
End With
With .Borders(wdBorderRight)
.LineStyle = wdLineStyleDot
.LineWidth = wdLineWidth025pt
End With
With .Borders(wdBorderTop)
.LineStyle = wdLineStyleDot
.LineWidth = wdLineWidth025pt
End With
With .Borders(wdBorderBottom)
.LineStyle = wdLineStyleDot
.LineWidth = wdLineWidth025pt
End With
With .Borders(wdBorderHorizontal)
.LineStyle = wdLineStyleDot
.LineWidth = wdLineWidth025pt
End With
With .Borders(wdBorderVertical)
.LineStyle = wdLineStyleDot
.LineWidth = wdLineWidth025pt
End With
.Borders.Shadow = False
End With
With Options
.DefaultBorderLineStyle = wdLineStyleDot
.DefaultBorderLineWidth = wdLineWidth025pt
End With
With Selection.Tables(1)
.Range.Cells.VerticalAlignment = wdCellAlignVerticalTop
.TopPadding = CentimetersToPoints(0.1) 0,1 cm Freiraum zwischen Tabellenrand
.BottomPadding = CentimetersToPoints(0.1) und Zeichen.
.LeftPadding = CentimetersToPoints(0.1)
.RightPadding = CentimetersToPoints(0.1)
.Spacing = 0
.AllowPageBreaks = True
.AllowAutoFit = True
.Rows.LeftIndent = CentimetersToPoints(0.1)
End With
  End Sub  
Alle Dateien eines Sub AlleDateienEinesVerzeichnissesEinfügen() Vor Ausführen des Makros muss zuerst eine
Verzeichnisses Dim myName$ Datei manuell über den Word-Dateimanager
einfügen Documents.Add eingefügt werden !!!
ChDir "G:\Referenz\details_neu"
myName = Dir("*.ht*")
While myName <> ""
Selection.InsertFile filename:=myName, _
ConfirmConversions:=False
myName = Dir()
Wend
  End Sub  
Sponsoren und Investoren

Sponsoren und Investoren sind jederzeit herzlich willkommen!
Wenn Sie die Information(en) auf dieser Seite interessant fanden, freuen wir uns über eine kleine Spende. Empfehlen Sie uns bitte auch in Ihren Netzwerken (z. B. Twitter, Facebook oder Google+). Herzlichen Dank!

Nach oben Sitemap
Impressum & Kontakt