Word VBA Zellenrahmen nur oben

Stefanabg · 19. Oktober 2017

Hallo Freunde der IT,
ich sitze hier an einer (für mich) kniffligen Sache.
Über ein VBA Makro wird bei uns eine Tabelle mit Informationen gefüllt. Nun soll ein Rahmen in der ersten Tabellenzeile gesetzt werden und zwar nur oben. Ich habe nun einige Varianten probiert, aber das einzige was wirklich klappt, ist den Rahmen komplett um die Zellen zu ziehen

Könnt ihr mir bitte behilflich sein?

Das ist der Code:

Code:

Sub editProduct(Optional ByVal endOfTables As Boolean = False)
    tableId = getArticleTable
    Dim hEndOfTables As Integer
    If endOfTables = True Then
        hEndOfTables = tableId
        tableId = ActiveDocument.Tables.Count - 1
    End If
    
    With ActiveDocument
        'Dritte Zeile der Tabelle anlegen, wenn Sie nicht existiert
            If .Tables(tableId).Rows.Count < 8 Then
                For i = .Tables(tableId).Rows.Count To 7 Step 1
                    If ActiveDocument.Tables(tableId).Rows.Count > 2 And ActiveDocument.Tables(tableId).Columns.Count > 5 And Not InStr(1, ActiveDocument.Tables(tableId).Cell(Row:=1, Column:=1).Range.Text, "Pos", vbTextCompare) And Len(ActiveDocument.Tables(tableId).Cell(Row:=1, Column:=1).Range.Text) > 3 Then
                        .Tables(tableId).Rows.Add
                        If .Tables(tableId).Rows(i).Cells.Count < 6 Then
                            .Tables(tableId).Cell(Row:=i, Column:=3).Split NumRows:=1, NumColumns:=(7 - .Tables(tableId).Rows(i).Cells.Count)
                        End If
                        '.Tables(tableId).Cell(Row:=3, Column:=6).Split NumRows:=1, NumColumns:=2
                        .Tables(tableId).Cell(Row:=i, Column:=1).Width = .Tables(tableId).Cell(Row:=1, Column:=1).Width
                        .Tables(tableId).Cell(Row:=i, Column:=2).Width = .Tables(tableId).Cell(Row:=1, Column:=2).Width
                        .Tables(tableId).Cell(Row:=i, Column:=3).Width = .Tables(tableId).Cell(Row:=1, Column:=3).Width
                        .Tables(tableId).Cell(Row:=i, Column:=4).Width = .Tables(tableId).Cell(Row:=1, Column:=4).Width - 15
                        .Tables(tableId).Cell(Row:=i, Column:=4).Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
                        .Tables(tableId).Cell(Row:=i, Column:=5).Width = .Tables(tableId).Cell(Row:=1, Column:=5).Width + 15
                        .Tables(tableId).Cell(Row:=i, Column:=5).Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
                        .Tables(tableId).Cell(Row:=i, Column:=6).Width = .Tables(tableId).Cell(Row:=1, Column:=6).Width
                        .Tables(tableId).Cell(Row:=i, Column:=6).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
                    End If
                Next
            End If
            If .Tables(tableId).Rows.Count > 7 Then
                .Tables(tableId).Rows(8).Delete
            End If
            
            'Zusatzzeilen leeren
            .Tables(tableId).Cell(Row:=3, Column:=2).Range.Text = ""
            .Tables(tableId).Cell(Row:=3, Column:=3).Range.Text = ""
            .Tables(tableId).Cell(Row:=4, Column:=2).Range.Text = ""
            .Tables(tableId).Cell(Row:=4, Column:=3).Range.Text = ""

            
            
            'Erste Zeile
            .Tables(tableId).Cell(Row:=1, Column:=1).Range.Text = "Pos"
            .Tables(tableId).Cell(Row:=1, Column:=3).Range.Text = ArticleAdd.TB_ArtNr.Text
            .Tables(tableId).Cell(Row:=1, Column:=4).Range.Text = ArticleAdd.TB_ArtMenge.Text
            .Tables(tableId).Cell(Row:=1, Column:=5).Range.Text = ArticleAdd.TB_ArtEp.Text
            .Tables(tableId).Cell(Row:=1, Column:=6).Range.Text = ArticleAdd.TB_ArtGp.Text
            
            'Zweite Zeile
            .Tables(tableId).Cell(Row:=2, Column:=3).Range.Text = ArticleAdd.TB_ArtBeschreibung.Text
            
            'Zusatzzeilen füllen (3-7)
            .Tables(tableId).Cell(Row:=3, Column:=6).Range.Text = Format(((ArticleAdd.TB_ArtEp.Text - ArticleAdd.TB_ArtVerkaufspreis.Text) * ArticleAdd.TB_ArtMenge.Text) * -1, "##,##0.00 ")
            .Tables(tableId).Cell(Row:=4, Column:=6).Range.Text = Format(ArticleAdd.TB_ArtVerkaufspreis.Text, "##,##0.00 ")
            .Tables(tableId).Cell(Row:=5, Column:=6).Range.Text = ArticleAdd.TB_ArtKondition.Text
            .Tables(tableId).Cell(Row:=6, Column:=6).Range.Text = Format(ArticleAdd.TB_ArtEinkaufspreis.Text, "##,##0.00 ")
            .Tables(tableId).Cell(Row:=7, Column:=6).Range.Text = ArticleAdd.TB_ArtAufschlag.Text
            
            'Bild ind zweite Spalte der Tabelle hinzufügen
            If .Tables(tableId).Cell(Row:=2, Column:=2).Range.InlineShapes.Count > 0 Then
                .Tables(tableId).Cell(Row:=2, Column:=2).Range.InlineShapes.Item(1).Delete
            End If
            .Tables(tableId).Cell(Row:=2, Column:=2).Range.Select
            If Len(ArticleAdd.TB_ArtBildlink.Text) > 5 Then
                InsertImage
            End If
    End With
    If endOfTables = True Then
        tableId = hEndOfTables
        hEndOfTables = 0
    End If

End Sub

Ergänzung (19. Oktober 2017)

Sorry für die Störung Leute, ich habs grad selbst gelöst

de la Cruz · 20. Oktober 2017

Probier mal das :

Rows("1:1").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A2").Select
End Sub

Suche

Word VBA Zellenrahmen nur oben

Stefanabg

Cadet 4th Year

de la Cruz

Banned

Ähnliche Themen