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.635 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. |
TOP! Unser Nr. 1 Neu! sevDataGrid 3.0 Mehrspaltige Listen, mit oder ohne DB-Anbindung. Autom. Sortierung, Editieren von Spalteninhalten oder das interaktive Hinzufügen von Datenzeilen sind ebenso möglich wie das Erstellen eines Web-Reports. Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. Access-Tools Vol.1 Über 400 MByte Inhalt Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB |
||||||||||||||||
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. |