Thema Datum  Von Nutzer Rating
Antwort
18.06.2019 09:13:41 Marten Frier
Solved
Blau Tabelle erstellen
 21.06.2019 00:12:47 Ben
*****
Solved
28.06.2019 14:31:05 Marten
Solved
28.06.2019 14:48:45 Marten
Solved

Ansicht des Beitrags:
Von:
Ben		 Datum:
21.06.2019 00:12:47		 Views:
625		 Rating:
     
Antwort:
 Nein
Thema:
Tabelle erstellen

Hallo,

folgender VBA-Code sollte das gewünschte umsetzen:

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
Public Sub Tabelle2er2Rows()
    Call doTabelle(2, 2)
End Sub
 
Public Sub Tabelle2er()
    Call doTabelle(1, 2)
End Sub
 
 
Public Sub Tabelle1er2Rows()
    Call doTabelle(2, 1)
End Sub
 
Public Sub Tabelle1er()
    Call doTabelle(1, 1)
End Sub
 
 
' <parameters name="NumRows">Anzahl der Zeilen: Gültige Werte 1 oder 2</parameters>
' <parameters name="NumCols">Anzahl der Spalten: Gültige Werte 1 oder mehr</parameters>
Private Sub doTabelle(NumRows As Integer, NumCols As Integer)
    If NumCols < 2 Then
        NumCols = 1
    Else
        NumCols = NumCols + (NumCols - 1)
    End If
    Dim objTab As Table
    Set objTab = ActiveDocument.Tables.Add(Range:=Selection.Range, NumRows:=1, NumColumns:= _
        NumCols, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
        wdAutoFitFixed)
    With objTab
        If .Style <> "Tabellenraster" Then
            .Style = "Tabellenraster"
        End If
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = False
        .ApplyStyleRowBands = True
        .ApplyStyleColumnBands = False
         
        .TopPadding = CentimetersToPoints(0)
        .BottomPadding = CentimetersToPoints(0)
        .LeftPadding = CentimetersToPoints(0.19)
        .RightPadding = CentimetersToPoints(0.19)
        .Spacing = 0
        .AllowPageBreaks = True
        .AllowAutoFit = False
        With .Range
            Dim iCol As Integer
             
            For iCol = 1 To .Rows(1).Cells.Count
                '.Cells(1).Range.ParagraphFormat
                With .Cells(iCol)
                    .WordWrap = False
                    .FitText = False
                    .PreferredWidthType = wdPreferredWidthPoints
                    .PreferredWidth = CentimetersToPoints(7.3)
                    .VerticalAlignment = wdCellAlignVerticalCenter
                    If iCol / 2 = Int(iCol / 2) Then
                        .Borders(wdBorderTop).LineStyle = wdLineStyleNone
                        .Borders(wdBorderBottom).LineStyle = wdLineStyleNone
                        .PreferredWidth = CentimetersToPoints(1)
                    Else
                        With .Range.ParagraphFormat
                            .Alignment = wdAlignParagraphCenter
                            .LeftIndent = CentimetersToPoints(0)
                            .RightIndent = CentimetersToPoints(0)
                            .SpaceBefore = 0
                            .SpaceBeforeAuto = False
                            .SpaceAfter = 0
                            .SpaceAfterAuto = False
                            .LineSpacingRule = wdLineSpaceSingle
                            .Alignment = wdAlignParagraphLeft
                            .WidowControl = True
                            .KeepWithNext = False
                            .KeepTogether = False
                            .PageBreakBefore = False
                            .NoLineNumber = False
                            .Hyphenation = True
                            .FirstLineIndent = CentimetersToPoints(0)
                            .OutlineLevel = wdOutlineLevelBodyText
                            .CharacterUnitLeftIndent = 0
                            .CharacterUnitRightIndent = 0
                            .CharacterUnitFirstLineIndent = 0
                            .LineUnitBefore = 0
                            .LineUnitAfter = 0
                         
                        End With
                    End If
                End With
            Next
            With .Rows
                .Alignment = wdAlignRowCenter
                .HeightRule = wdRowHeightAtLeast
                .Height = CentimetersToPoints(5.4)
                .AllowBreakAcrossPages = False
            End With
        End With
         
        .TopPadding = CentimetersToPoints(0)
        .BottomPadding = CentimetersToPoints(0)
        .LeftPadding = CentimetersToPoints(0.19)
        .RightPadding = CentimetersToPoints(0.19)
        .Spacing = 0
        .AllowPageBreaks = True
        .AllowAutoFit = False
 
    End With
    If NumRows = 2 Then
        Dim objRw As Row
        Set objRw = objTab.Rows.Add
        With objRw
            .Borders(wdBorderLeft).LineStyle = wdLineStyleNone
            .Borders(wdBorderRight).LineStyle = wdLineStyleNone
            .Borders(wdBorderBottom).LineStyle = wdLineStyleNone
            .Borders(wdBorderVertical).LineStyle = wdLineStyleNone
            With .Range
                .Style = "Bildbeschriftung"
                .Font.Size = 9
                .Font.Name = "Myriad Pro"
                .Font.Italic = True
                .ParagraphFormat.Alignment = wdAlignParagraphCenter
            End With
        End With
    End If
    objTab.Range.Select
End Sub

Da die einzelnen Varianten zum größten Teil funktionell identisch sind, habe ich diese in einer Sub zusammengefasst.

Tabelle1er

Erstellt eine Tabelle mit einer Zelle

Tabelle1er2Rows

Erstellt eine Tabelle mit einer Zelle und einer Beschriftungszeile.

Tabelle2er

Erstellt eine Tabelle mit zwei Spalten

Tabelle2er2Rows

Erstellt eine Tabelle mit zwei Spalten und einer Beschriftungszeile.

doTabelle(NumRows, NumCols)

Dieser Befehl erstellt die gewünschte Tabelle in der Variante.

NumRows: Anzahl der Zeilen (1 oder 2)
NulCols: Anzahl der Spalten 1 oder mehr)

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
18.06.2019 09:13:41 Marten Frier
Solved
Blau Tabelle erstellen
 21.06.2019 00:12:47 Ben
*****
Solved
28.06.2019 14:31:05 Marten
Solved
28.06.2019 14:48:45 Marten
Solved