none
Largeur dans un tableau RRS feed

  • Question

  • Bonjour tout le monde,

    J'ai copié un tableau d'une page web vers un document Word, puis à l'aide d'une macro en VBA j'ai récupéré des informations de la première cellule vers les autres.

    Des lignes ont deux colonnes, une n'a qu'une cellule avec colspan="2".

    Au départ la largeur de la première colonne est fournie dans le tableau web, mais on dirait que les éditions réalisées par la macro Word ont modifié cette largeur, et même pas de manière homogène d'une occurrence du tableau à l'autre.

    J'ai essayé de rectifier le tir sous Word avec Ro.Cells(1).Width = 100, mais le résultat n'est pas homogène non plus, curieusement.

    Quelqu'un voit-il quoi faire ?

    Voici un exemple du tableau :

    name

    Function

    @FunctionName

    Description

    Config controller

    Method Type

    Parameters (see following lines, if any : lines with blank cell at left)

    Sample call

    http://localhost:57922/api/v1.0/@controller/@FunctionName

    Example of input data

    Output(JSON)



    Peut-être que le code de la macro aiderait :

                          

    Sub CorrectProjectContent()
        Dim strDocName As String
        Dim A As Object
        Dim R As Range
        Dim Ro As Row
        Dim tbl As Table
        Dim strAddress As String
        Dim strElem() As String
        Dim strEsp As String
        Dim strContr As String
        Dim strFunct As String

        For Each tbl In ActiveDocument.Tables
            Set R = tbl.Cell(1, 1).Range
            strAddress = R.Hyperlinks(1).Address
            strElem = Split(strAddress, ".")
            strEsp = strElem(0)
            strContr = strElem(3)

            If (PosPoint4(strAddress) > 0) Then
              strFunct = Mid$(strAddress, PosPoint4(strAddress) + 1)
            Else
              strFunct = ""
            End If

            'MsgBox "strFunct : " + strFunct
            tbl.Select
            With tbl.Range.Find
              'If (.Found) Then
                  .Execute FindText:="@FunctionName", ReplaceWith:=strFunct
                  Selection.Range.Shading.BackgroundPatternColor = wdColorAqua
                  'MsgBox "Function name : " + strFunct
                  Selection.Range.Shading.BackgroundPatternColor = wdColorAutomatic
              'End If
              If (.Found) Then
                  tbl.Range.Find.Execute FindText:="@FunctionName", ReplaceWith:=strFunct
                  Selection.Range.Shading.BackgroundPatternColor = wdColorAqua
                  'MsgBox "Function name : " + strFunct
                  Selection.Range.Shading.BackgroundPatternColor = wdColorAutomatic
              End If
              tbl.Cell(1, 1).Select
              tbl.Select
              'Selection.GoTo wdGoToTable, wdGoToPrevious
            End With
            tbl.Range.Find.Execute FindText:="@controller", ReplaceWith:=strContr
            Selection.Range.Shading.BackgroundPatternColor = wdColorAqua
            'MsgBox "Controller : " + strContr
            Selection.Range.Shading.BackgroundPatternColor = wdColorAutomatic
            '//tbl.Rows(1).Cells(1).Shading.BackgroundPatternColorIndex = wdTurquoise
            'For Each Ro In tbl.Rows
            '    If (Ro.Cells.Count > 1) Then
            '      Ro.Cells(1).Width = 100
            '      Ro.Cells(2).Width = 500
            '    End If
            'Next
        Next
        Exit Sub
    ErrProjectContent:
        strFunct = ""
        Resume Next
    End Sub
    ' *************************************************
    Function NbPresCar(car As String, strRef As String) As Integer
    Dim i As Integer
    Dim n As Integer
    i = InStr(1, strRef, car)
    If i = 0 Then
        NbPresCar = 0
        Exit Function
    End If

    While i > 0
        i = InStr(i + 1, strRef, car)
        n = n + 1
    Wend
    NbPresCar = n
    End Function
    ' *************************************************

    Function PosPoint4(strRef As String) As Integer
    Dim i As Integer

    i = InStr(1, strRef, ".")
    If i = 0 Then
        PosPoint4 = 0
        Exit Function
    End If

    i = InStr(i + 1, strRef, ".")
    If i = 0 Then
        PosPoint4 = 0
        Exit Function
    End If

    i = InStr(i + 1, strRef, ".")
    If i = 0 Then
        PosPoint4 = 0
        Exit Function
    End If

    i = InStr(i + 1, strRef, ".")
    If i = 0 Then
        PosPoint4 = 0
        Exit Function
    End If
    PosPoint4 = i

    End Function




    • Modifié Gloops jeudi 19 septembre 2019 09:09
    jeudi 19 septembre 2019 08:37