Word VBA Zellenrahmen nur oben

[Stefanabg]

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:

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]

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