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.737 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. |
sevISDN 1.0 Überwachung aller eingehender Anrufe! Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Tipp des Monats Mai 2024 Hermann Röttger Wochentage eines Datumsbereichs ermitteln Wochentage eines Datumsbereichs ermitteln, optional mit Feiertagsberechnung Neu! sevDTA 3.0 Pro SEPA mit Kontonummernprüfung Erstellen von SEPA-Dateien mit integriertem BIC-Verzeichnis und Konto- nummern-Prüfverfahren, so dass ungültige Bankdaten bereits im Vorfeld ermittelt werden können. |
||||||||||||||||
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. |