donner un ID aux cellules html correspondant aux adresses des cellules corespondantes excel

**patricktoulon** · 21/01/2017, 13h44

Bonjour a tous je tourne en rond depuis tout a l'heure et je n'arrive pas a faire ce que je veux

voila je transforme une plage excel en html en les copiant(rng.copy) puis en la collant dans un document html content editable dans un webbrowser
jusque la ca match
mais il y a certain défaut d'alignement de texte en tre autre

si je le fait en dom j'y arrive c'est beaucoup plus long la conversion (excel to html )

je voudrais pour pouvoir agir sur ces cellules html dans mon document ajouter le "ID a chaque cellules correspondantes
facile me direz vous .. et oui mais non si il y a des fusions c'est plus compliqué héhé!!

j'ai bien essayé ceci pourtant logique mais ne fonctionne pas les id sont mal distribués

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
for i = 1 to rng.cells.count 
if not dico.exists(rng.cells(1).mergearea.address) then 
dico(rng.cells(1).mergearea.address)=""
'.....dans le dico j'ai bien le même nombre de cel excel que de cel html
a=a+1
mestd(a-1).id=rng.cells(a).mergearea.address
end if

mon code pour transformer excel en html

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub test1Wbr()
    Dim tablehtml As String    'variable
    tablehtml = range_to_html_sans_codagehtml2(Sheets(1).Range("A4:C" & Cells(Rows.Count, 1).End(xlUp).Row))    'plage a adapter
   Set IE = CreateObject("internetexplorer.application")
    With IE
        .Visible = True: .Left = 100: .Navigate "about:blank"    ' la position de la fenetre ie est en dehors du chanps de l'ecran (pas la peine dela voir ca n'est pas necessaire
        .Document.write tablehtml
    End With
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Function range_to_html_sans_codagehtml2(Optional rng As Range) As String
    Dim myWebBrowser, wb, i As Long, mesTD As Object, codebase As String, dico, a
    Set dico = CreateObject("scripting.dictionary")
    codebase = "<html><body><br><div id=""calque"" contenteditable=true style=""width:80%;height:80%;""></div></body></html>"    'code de base avec mon div conteneditable
    If rng Is Nothing Then Set rng = Application.InputBox(prompt:="Sample", Type:=8)
    Set myWebBrowser = Sheets(1).OLEObjects.Add(ClassType:="Shell.Explorer.2", Left:=1, Top:=1, Width:=700, Height:=800)
    myWebBrowser.Activate:
    Set wb = myWebBrowser.Object
    rng.Copy
    With wb
        .Silent = True: .Navigate "about:blank": .Document.write codebase: .Document.getelementbyid("calque").Focus
        .Document.execcommand "paste", False, Null    'j'execute la commande javascript "Paste"
        Set mesTD = .Document.getelementsbytagname("TD")    'je collectionne tout les balises "TD"
 
        For i = 0 To mesTD.Length - 1
 
            'je met toutes les bordures xlnone de la plage en couleur resemblante a celle du xlnone( bleu/grisclair)
            If Not mesTD(i).Style.bordertop Like "*pt*" Then mesTD(i).Style.bordertop = "0.5pt solid #A9BCF5"
            If Not mesTD(i).Style.borderbottom Like "*pt*" Then mesTD(i).Style.borderbottom = "0.5pt solid #A9BCF5"
            If Not mesTD(i).Style.borderleft Like "*pt*" Then mesTD(i).Style.borderleft = "0.5pt solid #A9BCF5"
            If Not mesTD(i).Style.borderright Like "*pt*" Then mesTD(i).Style.borderright = "0.5pt solid #A9BCF5"
            'If rng.Cells(i + 1).MergeArea.HorizontalAlignment <> 1 Then mesTD(i).Style.textAlign = "center"
        Next
        range_to_html_sans_codagehtml2 = .Document.getelementbyid("calque").innerhtml    'la fonction devient le string du code html de la plage correspondante
    End With
    myWebBrowser.Delete
    Application.CutCopyMode = False    'on debloque la plage en pointillés (due a copy)
    Application.CutCopyMode = True    'on debloque la plage en pointillés (due a copy)
End Function

merci pour les retours

**patricktoulon** · 21/01/2017, 14h36

re
bon ben j'ai trouver le moyen de lister dans l'ordre c'est bon

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
For lig = rng.Row To rng.Rows.Count + rng.Row - 1
            For col = rng.Column To rng.Column + rng.Columns.Count - 1
                If Not dico.exists(Cells(lig, col).MergeArea.Address) Then
                    dico(Cells(lig, col).MergeArea.Address) = ""
                    a = a + 1: mesTD(a - 1).ID = Cells(lig, col).MergeArea.Address
                End If
            Next
        Next

c'est résolu!!!

donner un ID aux cellules html correspondant aux adresses des cellules corespondantes excel

Macros et VBA Excel

Discussions similaires

Partager

Partager