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 Dieser Tipp wurde bereits 8.675 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 sevZIP40 Pro DLL Zippen und Unzippen wie die Profis! Mit nur wenigen Zeilen Code statten Sie Ihre Anwendungen ab sofort mit schnellen Zip- und Unzip-Funktionen aus. Hierbei lassen sich entweder einzelnen Dateien oder auch gesamte Ordner zippen bzw. entpacken. |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |