Rubrik: Word | VB-Versionen: VBA | 21.04.15 |
VBA-Funktionen #2, Funktionen zur Verwendung an Word-Tabellen Im Tipp werden mehrere Funktionen vorgestellt, die bei der programmtechnischen Arbeit mit Word-Tabellen verwendet werden können. | ||
Autor: Dietrich Herrmann | Bewertung: | Views: 8.690 |
ohne Homepage | System: Win7, Win8, Win10, Win11 | kein Beispielprojekt |
In diesem Tipp veröffentliche ich mehrere Funktionen zu Word-Tabellen-Programmierung, die ich in kleinen, später hier gezeigten Projekten verwenden werde. Sie werden ebenfalls wie die Funktionen im Tipp VBA-Funktionen #1, bestimmte Funktionen zur Array-Verwendung im Voraus mitgeteilt (und können natürlich vom Anwender nach eigenen Bedürfnissen modifiziert und variiert werden).
Hier die Funktionen, die durch die Parameter recht selbsterkärend sind.
' Ermitteln der Tabellennummer, in der sich der Cursor befindet ' Rückgabe: die Tabellennummer Public Function WhichTableNumber() As Integer Dim i As Integer With selection If ActiveDocument.Tables.Count = 0 Or Not .Information(wdWithInTable) Then MsgBox "Cursor befindet sich nicht in einer Tabelle!" WhichTableNumber = 0 Exit Function End If For i = 1 To ActiveDocument.Tables.Count If (.Range.Start >= ActiveDocument.Tables(i).Range.Start) And _ (.Range.End <= ActiveDocument.Tables(i).Range.End) Then Exit For End If Next i End With WhichTableNumber = i End Function
' Erstellen einer neuen Tabelle an der Cursorposition ' colNums: die Anzahle der Spalten ' rowNums: die Anzahl der Zeilen ' prozentual: die prozentuale Breitenverteilung der Spalten ' Rückgabe: die Nummer der Tabelle im Dokument Public Function CreateTable(colNums As Integer, rowNums As Integer, Optional prozentual As Variant) ActiveDocument.Tables.Add Range:=selection.Range, NumRows:=rowNums, NumColumns:=colNums, _ DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed If Not IsMissing(prozentual) Then ' prozentuale Spaltenbreiten setzen setProz ActiveDocument.Tables(ActiveDocument.Tables.Count), prozentual ' Tabellengitter erzeugen setGridLines ActiveDocument.Tables(ActiveDocument.Tables.Count) End If CreateTable = ActiveDocument.Tables(ActiveDocument.Tables.Count) End Function
' Die Spaltenbreiten einer Tabelle prozentual berechnen und verteilen ' tb: die Tabelle ' prozentual: ein Feld der Prozentzahlen für die Spaltenbreiten Public Sub setProz(tb As Word.table, prozentual As Variant) Dim i As Integer, co As Integer With tb .AllowAutoFit = False .PreferredWidthType = wdPreferredWidthPercent co = .columns.Count For i = 0 To co - 1 If i > UBound(prozentual) Then Exit For .columns(i + 1).PreferredWidth = Val(prozentual(i)) Next End With End Sub
' Tabellengitter erzeugen ' tb: die Tabelle Public Sub setGridLines(tb As Word.table) tb.Rows(1).Cells(1).Select selection.Collapse selection.WholeStory WordBasic.ShowTableGridlines With selection.Borders(wdBorderTop) .LineStyle = Options.DefaultBorderLineStyle .LineWidth = Options.DefaultBorderLineWidth .Color = Options.DefaultBorderColor End With With selection.Borders(wdBorderLeft) .LineStyle = Options.DefaultBorderLineStyle .LineWidth = Options.DefaultBorderLineWidth .Color = Options.DefaultBorderColor End With With selection.Borders(wdBorderBottom) .LineStyle = Options.DefaultBorderLineStyle .LineWidth = Options.DefaultBorderLineWidth .Color = Options.DefaultBorderColor End With With selection.Borders(wdBorderRight) .LineStyle = Options.DefaultBorderLineStyle .LineWidth = Options.DefaultBorderLineWidth .Color = Options.DefaultBorderColor End With With selection.Borders(wdBorderHorizontal) .LineStyle = Options.DefaultBorderLineStyle .LineWidth = Options.DefaultBorderLineWidth .Color = Options.DefaultBorderColor End With End Sub
' Einfügen eines Dezimal-Tabstopps in die Zellen einer Tabellenspalte ' tb: die Tabelle ' col: die Spaltennummer ' w: der Wert der Stelle für den Tabstopp (~ die Mitte der Zelle) Public Sub AddDecimalTabToCell(tb As table, col As Integer, w As Single) ' to be expanded by inserting a decimal tab at 1.7 cm in all cells ' starting from row 2 of Column 2 and 3 Dim mytable As table, i As Integer, cellT As Range, cw As Integer Set mytable = tb With mytable cw = .columns(col).Width For i = 1 To .Rows.Count Set cellT = mytable.Rows(i).Cells(col).Range cellT.ParagraphFormat.TabStops.Add Position:=cw \ 2, _ Alignment:=wdAlignTabDecimal, Leader:=wdTabLeaderSpaces Next End With End Sub
' Eine Bezeichnung als Über- oder Unterschrift zur Tabelle hinzufügen ' tb: die Tabelle ' str: der Text für die Bezeichnung ' pos: die Position für die Bezeichnung (unten bzw. oben) ' fontS: die Schriftgröße für die Bezeichnung ' fontC: die Farbe der Bezeichnung Public Sub TabelleUeberUnterschrift(tb As Word.table, str As String, pos As WdCaptionPosition, _ fontS As Integer, fontC As WdColor) Dim ad As Range Set ad = ActiveDocument.Range ' einfügen einer Bezeichnung tb.Range.InsertCaption Label:=wdCaptionTable, Title:=str, Position:=pos, ExcludeLabel:=True ' löschen der Nummerierung (Feld) ad.Fields(ad.Fields.Count).Delete ' formatieren des Absatzes mit der Bezeichnung With selection .Expand unit:=wdParagraph .Font.Size = fontS .Font.Color = fontC .Move unit:=wdParagraph End With tb.Range.Collapse wdCollapseStart End Sub