Tableaux WORD vers HTML [Résolu]

[luxmen]

Bonjour tout le monde...

J'ai un problème (encore), je vous explique :

J'utilise une macro pour convertir les tableaux WORD en HTML avec ce code :

Code :

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
Private Sub Conv_Tableaux_Click()
    Dim t As Table ' T c'est mon tableau
    Dim r As Row
    Dim stTexte As String
 
   ' Dim c As Cell
   'A voir comment sélectionner le bon tableau...
    Set t = ActiveDocument.Tables(1) ' Je prend le 1° tableau du document
 
    stTexte = "<center><table width=100% border=1>"
    For Each r In t.Range.Rows
       stTexte = stTexte & "<TR>"
       For Each c In r.Range.Cells
         stTexte = stTexte & "<TD><div align=center>" & NetCellule(c.Range.Text) & "</div></TD>"
       Next
       stTexte = stTexte & "</TR>" & Chr(13)
    Next
     stTexte = stTexte & "</TABLE></center>"
 
          stTexte = stTexte & "</TABLE>"
     Debug.Print stTexte
     t.Select
     t.Delete
     Selection.TypeText Text:=stTexte
End Sub

Mais j'ai une conversion bizarre au niveau des cellules :

Voici mon doc WORD : (il manque la cellule du titre du tableaux au dessus)


Et j'obtient ceci :


Auriez-vous des macros ou des corrections a celui-ci a me proposer ?

Je vous remercie pour votre aide

[bbil]

salut luxem ... bon j'ai regardé ton probléme... , du moins pour les lignes de titres.. tu as des cellules fusionées.. il faudrai rajouter

Code :

colspan=4

dans la définition de la celulle fusionée TD..., 4 étant le nombre de cellule fusionnée..., cependant sous Word , je n'arrive pas à déterminer le nombre de cellules fusionnée...

[luxmen]

Merci les gars...

BBil, T toujours la toi... (non stop connected)

C sympa, je vais essayer de voir ca....mais ca voudrait dire que je devrait faire en fonction de chaque tableau ?, exemple, si j'ai un tableau avec juste 3 cellule fusionné, mon script ne marchera pas alors...?

byebye et encore merci BBil

[bbil]

tiens j'ai quelque chose mais c'est un peu long ...

tous d'abords une fonction pour mémoriser l'emplacement des "bords" des colonnes... :

Code :

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
'
' Calcule emplacement des colonnes..
'
'
Private Sub Mes_Tableaux(T, tMes() As Single)
    Dim r As Row
    Dim c As Cell
    Dim sLargeur As Single
    Dim bTrouve As Boolean
    Dim i As Integer
    Dim j As Integer
    ReDim Preserve tMes(0)
    tMes(0) = 0
    For Each r In T.Range.Rows
        sLargeur = 0
 
        For Each c In r.Range.Cells
         sLargeur = sLargeur + c.PreferredWidth
         i = 0
         bTrouve = False
         While i <= UBound(tMes) And Not bTrouve
            If tMes(i) < sLargeur Then
             i = i + 1
             Else
              bTrouve = True
            End If
           Wend
           If Not bTrouve Then
              If tMes(i - 1) < sLargeur - 0.01 Then
                ReDim Preserve tMes(i)
                tMes(i) = sLargeur
              End If
           Else
            If tMes(i) - sLargeur > 0.1 Then
               For j = UBound(tMes) To i + 1 Step -1
                 tMes(j) = tMes(j - 1)
                Next
                 tMes(i) = sLargeur
            End If
           End If
        Next
    Next
 
End Sub

Puis une fonction qui à partir de la mémorisation précédente des "bords" des colonnes , et des "bords" d'une cellule , renvoi le nombre de cellules fusionnées...

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
'
' Calcul NbColonnes
'
'
Private Function iNbCol(c As Cell, sDepart As Single, tMes() As Single) As Integer
 Dim iDeb As Integer
 Dim iFin As Integer
 Dim i As Integer
 Dim bTrouver As Boolean
 iDeb = 0
 iFin = 0
 bTrouve = False
 While i <= UBound(tMes) And Not bTrouve
   If tMes(i) < sDepart + 0.01 Then iDeb = i
   iFin = i
   If tMes(i) >= c.PreferredWidth + sDepart Then bTrouve = True
 
   i = i + 1
  Wend
 iNbCol = iFin - iDeb
End Function

et maintenant l'utilisation dans ta fonction .. :

Code :

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
Private Sub Conv_Tableaux_Click()
    Dim T As Table ' T c'est mon tableau
    Dim r As Row
    Dim stTexte As String
    Dim sDepart As Single
    Dim stColSpan As String 'colonne fusionee
    Dim iCol As Integer
    Dim c As Cell
     Dim tMes() As Single 'Tableau emplacement des colonnes...
    Set T = ActiveDocument.Tables(1) ' Je prend le 1° tableau du document
    Mes_Tableaux T, tMes
    stTexte = "<center><table width=100% border=1>"
    For Each r In T.Range.Rows
       sDepart = 0
       stTexte = stTexte & "<TR>"
       For Each c In r.Range.Cells
         stColSpan = ""
         iCol = iNbCol(c, sDepart, tMes)
         If iCol > 1 Then stColSpan = " colspan=" & iCol & " "
 
         stTexte = stTexte & "<TD" & stColSpan & "><div align=center>" & NetCellule(c.Range.Text) & "</div></TD>"
         sDepart = sDepart + c.PreferredWidth
       Next
       stTexte = stTexte & "</TR>" & Chr(13)
    Next
     stTexte = stTexte & "</TABLE></center>"
 
          stTexte = stTexte & "</TABLE>"
     Debug.Print stTexte
     T.Select
     T.Delete
     Selection.TypeText Text:=stTexte
End Sub

bon courage....

[luxmen]

T un chef BBil, je vais tester ca....

[luxmen]

Wouaaaaou !!

Franchement BBil, T trop fort....ce Script il tu :-)

Ca marche superbement bien !! (chui trop content)

Encore merci !!

[Megaxel]

C'est bizarre, mais quand je vois dans le dernier message d'un post:

Ca marche superbement bien !! (chui trop content)

Encore merci !!

, je m'attend à voir le tag "Résolu"...
Allez, hop, un petit click sur le bouton, en bas à gauche.

[luxmen]

Salut les Pro de la Prog...

En fait j'ai passer une bonne partie de la journée a essayer de voir ce super truc (Merci BBil), mais y a un truc qui deconne, et je n'arrive pas a corriger.

Il y a un probleme de cellules

Je m'explique en images :

Ca c'est l'original :


Et en HTML, j'ai un probleme de cellule (j'avais pas vu...), la deuxieme ligne du tableau est mal analysée... :


Ca me fait 5 + 5 + 2 au lieu de 4 + 4 + 4

C'est bizarre non ?

*** Sinon, je vais encore vraiment abuser, mais y a pas moyen d'avoir toutes les lignes un peu comme ca :


Pour le *** dernier point, c'est pas grave si y a po moyen... , mais j'essaye, on ne sait jamais, car vous êtes tellement present et bons...que j'essaie quand même...!!

PS : sinon, megaxel, c moi qui doit mettre resolu sur mes Topics ou C l'admin ?

[bbil]

La somme des largeurs de cellules données par word ne me donne pas toujours la même valeur ... il y as des petit décalage ... pour rattraper cela modifie la fonction iNbCol :

Code :

1
2
3
4
5
6
7
8
9
10
11
 
...
bTrouve = False
 While i <= UBound(tMes) And Not bTrouve
   If tMes(i) < sDepart + 0.01 Then iDeb = i
   iFin = i
   If tMes(i) >= c.PreferredWidth + sDepart - 0.05 Then bTrouve = True
 
   i = i + 1
  Wend
...

par le rajout du -0.05



Pour ce qui est des cellules non encadrées ., c'est les cellules vides ...j'ai regardé la FAQ HTLM .. il est dit que pour éviter cela il faut mettre un espace dans le tableau <TD> <\TD> .. bon cela ne marche pas chez moi lors de lavisualisation sous Firefox par contre c'est ok si je rajoute un caractére Chr(160) ... donc pour cela modifie la fin de la fonction
NetCellule :

Code :

1
2
3
4
5
6
 
...
  If Len(st2) = 0 Then st2 = Chr(160)
  NetCellule = st2
 
 End Function

[luxmen]

Ca marche au poil...

bbil, je te décerne le prix du meilleurs "Helper" du net !!!

Tu m'a guidé pas a pas (moi qui suis un newb en VBA)....Enfin tu me sauve encore la vie (en plus c'est super cool, car je présente la macro a mon superieur ce matin)... je pense qu'il va aimer... !

Encore MERCI pour tout !!

Cette fois on peu mettre [RESOLU]

[Megaxel]

Alors oui: c'est toi qui met le tag en cliquant sur le bouton en bas à gauche quand tu ouvres ton post.

[AlainTech]

Pas certain que luxmen revienne voir son message...

Alors, je le mets, le tag!

[luxmen]

Salut,

Merci pour le [Resolu], ca y est je viens de voir ou c'etait ... je le saurais pour une autre fois...désolé !

[Heureux-oli]

Il semblerait que ce soit lié à ça

Code :

1
2
3
4
5
...
  If Len(st2) = 0 Then st2 = Chr(160)
  NetCellule = st2
 
 End Function

Petit conseil, il n'est pas souhaitable de faire remonter un message taggé résolu datant de 2005 pour y poser une question.

[elliotttt]

{Désolé pour répondre au message tagué résolu de 2005, mais j'aurais été hors-contexte si j'avais crée un nouveau sujet }
Bonjour, j'ai un petit (gros) probleme qui m'empeche d'avancer :
J'ai utilisé vos macros pour convertir mes tableaux, cela marche à merveille
Cependant, quand on tombe sur un tableau à lignes fusionnées, ça plante :

Code :

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
Private Sub Mes_Tableaux(t, tMes() As Single)
    Dim r As Row
    Dim c As Cell
    Dim sLargeur As Single
    Dim bTrouve As Boolean
    Dim i As Integer
    Dim j As Integer
    ReDim Preserve tMes(0)
    tMes(0) = 0
    For Each r In t.Range.Rows
        sLargeur = 0
        
        For Each c In r.Range.Cells
         sLargeur = sLargeur + c.PreferredWidth
         i = 0
         bTrouve = False
         While i <= UBound(tMes) And Not bTrouve
            If tMes(i) < sLargeur Then
             i = i + 1
             Else
              bTrouve = True
            End If
           Wend
           If Not bTrouve Then
              If tMes(i - 1) < sLargeur - 0.01 Then
                ReDim Preserve tMes(i)
                tMes(i) = sLargeur
              End If
           Else
            If tMes(i) - sLargeur > 0.1 Then
               For j = UBound(tMes) To i + 1 Step -1
                 tMes(j) = tMes(j - 1)
                Next
                 tMes(i) = sLargeur
            End If
           End If
        Next
    Next
 
End Sub

Message d'erreur : Impossible d'acceder à des colonnes individuelles de cette collection car le tableau possede des cellules fusionées verticalement.

Ligne d'erreur :

Code :

For Each r In t.Range.Rows

Can somebody PLEASE help me ?

[Heureux-oli]

Je ne vois pas pourquoi, il suffit de faire pointer un lien vers la question initiale.