Bonjour,
Bonjour,
@Robert :
@Patrick :
Peut-être as tu recherché l'attribut "FontName" au lieu de "ss:FontName"...
J'ai fait une contribution (encore incomplète, mais qui attends vos désidératas) à ce sujet : ==ICI==
Cordialement,
Franck
a bon je croyais que c'était moi mais non
voila pijaku ce que je voulais expliquer
sans boucle en utilisant les index de la collection ca matche pas
je répète donc ma question plus précisément
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 Option Explicit Public Sub test() Dim docxml As New MSXML2.DOMDocument 'Nouveau doc Xml Dim Noeuds As IXMLDOMNodeList 'Liste de noeuds de docxml Dim E As IXMLDOMElement 'Elément Dim vIn As String 'A chercher Dim vOut As String 'Valeur de retour Dim i# With docxml If Not .LoadXML(Replace(Range("a1").Value(xlRangeValueXMLSpreadsheet), "ss:Data", "Data")) Then err.Raise .parseError.ErrorCode, , .parseError.reason 'recherche tous les noeuds appelés font Set Noeuds = .getElementsByTagName("Font") 'Nom de l'attribut à chercher vIn = "ss:FontName" Debug.Print Noeuds(0).XML' c'est bon il est bien identifié Debug.Print Noeuds(1).XML' c'est bon il est bien identifié Debug.Print Noeuds(0).getAttribute(vIn)' et toc!!!! ca matche pas End With Set docxml = Nothing Set Noeuds = Nothing End Sub
est il possible de récupérer l'attribut d'un élément sans boucler sur la collection d'élément du même tag
car pijaku dans ton exemple ca marche
mais si j'ai plus de 1 couleur dans la cellule ou une partie bold et tout simplement 2 partie de texte diffèrent il y a le code html de la valeur de cellule dans le tag DATA donc plus de 2 tag "font" dans le xml
les fonts qui sont dans le data n'ont pas d'attribut "fontname" mais "face" (c'est encodé en HTML)
je donne une exemple de xml
bref je veux que les font qui ne sont pas dans le DATA donc le (0) et le (1)
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
30
31 <?xml version="1.0"?> <?mso-application progid="Excel.Sheet"?> <Workbook xmlns="urn:schemas-microsoft-com:office:spreadsheet" xmlns:o="urn:schemas-microsoft-com:office:office" xmlns:x="urn:schemas-microsoft-com:office:excel" xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet" xmlns:html="http://www.w3.org/TR/REC-html40"> <Styles> <Style ss:ID="Default" ss:Name="Normal"> <Alignment ss:Vertical="Bottom"/> <Borders/> <Font ss:FontName="Calibri" x:Family="Swiss" ss:Size="11" ss:Color="#000000"/> <Interior/> <NumberFormat/> <Protection/> </Style> <Style ss:ID="m45881984"> <Alignment ss:Horizontal="Center" ss:Vertical="Center" ss:WrapText="1"/> <Borders> <Border ss:Position="Bottom" ss:LineStyle="Dot" ss:Weight="1" ss:Color="#FF0000"/> <Border ss:Position="Top" ss:LineStyle="Continuous" ss:Weight="3" ss:Color="#FF0000"/> </Borders> <Font ss:FontName="Calibri" x:Family="Swiss" ss:Size="11" ss:Color="#00FFFF"/> <Interior ss:Color="#FAC090" ss:Pattern="Solid"/> </Style> </Styles> <Worksheet ss:Name="Feuil1"> <Table ss:ExpandedColumnCount="1" ss:ExpandedRowCount="1" ss:DefaultColumnWidth="62.400000000000006" ss:DefaultRowHeight="14.4"> <Column ss:AutoFitWidth="0" ss:Width="95.399999999999991"/> <Row ss:AutoFitHeight="0" ss:Height="25.2"> <Cell ss:StyleID="m45881984"><ss:Data ss:Type="String" xmlns="http://www.w3.org/TR/REC-html40">g<B>g</B><Font html:Color="#00FFFF">gttt</Font><Font html:Color="#FF0000">t</Font><Font html:Face="Algerian" x:Family="Decorative" html:Color="#FF0000">tt</Font><Font html:Color="#FF0000">tt</Font><Font html:Color="#00FFFF">t</Font><B><Font html:Color="#00FFFF">g</Font><I><Font html:Size="16" html:Color="#00FFFF">gg</Font></I><Font html:Size="16" html:Color="#00FFFF">g</Font></B><Font html:Color="#00FFFF">gggg gggggggggghhhhhhhhhhhhhh</Font></ss:Data></Cell> </Row> </Table> </Worksheet> </Workbook>
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
re
en fait ca fonctionne comme ca
va savoir pourquoi "nœuds(0/1)" n'est pas un xmlelement dans un debug.print direct
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8 'recherche tous les noeuds appelés font Set Noeuds = .getElementsByTagName("Font") 'Nom de l'attribut à chercher vIn = "ss:FontName" Set n = Noeuds(0) Debug.Print n.getAttribute(vIn) Set n2 = Noeuds(1) Debug.Print n2.getAttribute(vIn)
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
Le principe :
1- on cible le parent des font que tu cherches, ici Style grâce à : .SelectSingleNode("/Workbook/Styles/Style")
2- on récupère tous les noeuds enfant de ce Noeud "cible" se nommant "Font", grâce à : .SelectNodes("Font")
3- on boucle sur la collection des noeuds Font ayant comme parent Style
4- On récupère les attributs grâce à la collection Attributes
5- on boucle sur les attributs et on récupère leur nom et leur valeur (grâce à getAttribute)
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
30
31
32
33
34 Option Explicit Public Sub AccessNode() Dim MyXml As New MSXML2.DOMDocument Dim Noeuds As IXMLDOMNodeList Dim NoeudCible As IXMLDOMNode Dim Noeud As IXMLDOMElement Dim Attributs As IXMLDOMNamedNodeMap 'Collection Dim A As IXMLDOMAttribute 'Pour boucler sur la collection Dim vOut As String With MyXml If Not .LoadXML(Replace(Range("a1").Value(xlRangeValueXMLSpreadsheet), "ss:Data", "Data")) Then Err.Raise .parseError.ErrorCode, , .parseError.reason 'accès au Noeud : '<Workbook> '<Styles> '<Style> Set NoeudCible = .SelectSingleNode("/Workbook/Styles/Style") If Not NoeudCible Is Nothing Then Set Noeuds = NoeudCible.SelectNodes("Font") For Each Noeud In Noeuds Set Attributs = Noeud.Attributes For Each A In Attributs vOut = Noeud.getAttribute(A.Name) Debug.Print A.Name & " " & vOut Next Next End If End With Set NoeudCible = Nothing Set Attributs = Nothing Set Noeud = Nothing Set MyXml = Nothing End Sub
Cordialement,
Franck
Si tu déclares Noeuds As IXMLDOMNodeList, et que tu boucles sur cette collection grâce aux Items (Noeuds(0), Noeuds(1), etc...), les éléments de cette collection seront du type IXMLDOMNode.
Or, il s'avère que (la consultation de l'explorateur d'objet le confirme), l'objet IXMLDOMNode n'a pas la méthode getAttributes.
Par contre, l'objet IXMLDOMElement lui, la possède.
Donc, il suffit de boucler sur la Collection IXMLDOMNodeList, non pas par les Items, mais grâce à une variable IXMLDOMElement.
Tout simplement.
Cordialement,
Franck
re
je pense que j'ai trouver bonheur
merci pijaku
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
30
31
32
33
34
35 Option Explicit Public Sub test() Dim docxml As New MSXML2.DOMDocument 'Nouveau doc Xml Dim Noeuds As Object, innerH, cel As Range 'Liste de noeuds de docxml Dim Font_Name$, Font_Size$, Font_Color$, innerhtmls$ Set cel = Sheets(1).Range("B3") With docxml If Not .LoadXML(Replace(cel.Value(xlRangeValueXMLSpreadsheet), "ss:Data", "Data")) Then err.Raise .parseError.ErrorCode, , .parseError.reason 'recherche tous les noeuds appelés font Set Noeuds = .getElementsByTagName("Font") 'le font name Font_Name = Noeuds(0).getAttribute("ss:FontName") Font_Name = Noeuds(1).getAttribute("ss:FontName") 'le font size Font_Size = Noeuds(0).getAttribute("ss:Size") Font_Size = Noeuds(1).getAttribute("ss:Size") 'le font color Font_Color = Noeuds(1).getAttribute("ss:Color") 'on prends le 2 automatiquement ' si il y a des font dans la valeur de data alors on prends le 1 If IsNull(cel.Font.Color) Then Font_Color = Noeuds(0).getAttribute("ss:Color") Debug.Print "propriété Globale du texte de la cellule : " & vbCrLf & Font_Name & " " & Font_Size & " " & Font_Color Debug.Print " " 'la valeur de la cellule Set innerH = docxml.SelectSingleNode("/Workbook/Worksheet/Table/Row/Cell/Data") 'la cellule au format text Debug.Print "la cellule au format text : " & vbCrLf & innerH.Text Debug.Print " " ' la cellule au format HTML : " innerhtmls = Split(innerH.XML, Split(innerH.XML, ">")(0) & ">")(1) innerhtmls = Split(Replace(Replace(innerhtmls, "xmlns:html=""http://www.w3.org/TR/REC-html40""", ""), "html:", ""), "</Data")(0) Debug.Print "la cellule au format HTML : " & vbCrLf & innerhtmls End With Set docxml = Nothing Set Noeuds = Nothing End Sub
si il y a moyen de prendre le InnerHTML plus proprement je prends
si tu comprends pas pourquoi je réinitialise les variables font_name et font_size 2 fois tu n'a qua regarder le font_color tu devinera pourquoi
ou en testant une cellule tout en rouge par exemple ou une cellule avec une/des parties différentes du reste du texte dans une cellule en terme de format
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
Ben oui en fait il y a plusieurs possibilités et cela en fonction de l'extraiXml retourné
si tu a une cellule avec le texte tout de la même couleur le innerhtml et pareil que le innertext et les couleur sont a prendre dans le 2 d font name
si ta cellule contient un texte de plusieurs couleur le innerhtml est au format html donc si le/les premier(s) caractère(s) sont noirs et un font name normal alors il faut ajouter un font global dans le innerhtml
et ce font sera au format des attributs récupérés dans les fonts (0/1) qui sont des balises style
ca a l'air compliqué mais pas du tout le html je métrise plutôt bien
exemple
xml retourné
on voit bien que dans le innerhtml de la cellule la 1 ere lettre n'est pas dans une balise et donc pas de format
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
30
31 <?xml version="1.0"?> <?mso-application progid="Excel.Sheet"?> <Workbook xmlns="urn:schemas-microsoft-com:office:spreadsheet" xmlns:o="urn:schemas-microsoft-com:office:office" xmlns:x="urn:schemas-microsoft-com:office:excel" xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet" xmlns:html="http://www.w3.org/TR/REC-html40"> <Styles> <Style ss:ID="Default" ss:Name="Normal"> <Alignment ss:Vertical="Bottom"/> <Borders/> <Font ss:FontName="Calibri" x:Family="Swiss" ss:Size="11" ss:Color="#000000"/> <Interior/> <NumberFormat/> <Protection/> </Style> <Style ss:ID="m45881984"> <Alignment ss:Horizontal="Center" ss:Vertical="Center" ss:WrapText="1"/> <Borders> <Border ss:Position="Bottom" ss:LineStyle="Dot" ss:Weight="1" ss:Color="#FF0000"/> <Border ss:Position="Top" ss:LineStyle="Continuous" ss:Weight="3" ss:Color="#FF0000"/> </Borders> <Font ss:FontName="Calibri" x:Family="Swiss" ss:Size="11" ss:Color="#00FFFF"/> <Interior ss:Color="#FAC090" ss:Pattern="Solid"/> </Style> </Styles> <Worksheet ss:Name="Feuil1"> <Table ss:ExpandedColumnCount="1" ss:ExpandedRowCount="1" ss:DefaultColumnWidth="62.400000000000006" ss:DefaultRowHeight="14.4"> <Column ss:AutoFitWidth="0" ss:Width="95.399999999999991"/> <Row ss:AutoFitHeight="0" ss:Height="25.2"> <Cell ss:StyleID="m45881984"><Data ss:Type="String" xmlns="http://www.w3.org/TR/REC-html40">g<B>g</B><Font html:Color="#00FFFF">gttt</Font><Font html:Color="#FF0000">t</Font><Font html:Face="Algerian" x:Family="Decorative" html:Color="#FF0000">tt</Font><Font html:Color="#FF0000">tt</Font><Font html:Color="#00FFFF">t</Font><B><Font html:Color="#00FFFF">g</Font><I><Font html:Size="16" html:Color="#00FFFF">gg</Font></I><Font html:Size="16" html:Color="#00FFFF">g</Font></B><Font html:Color="#00FFFF">gggg gggggggggghhhhhhhhhhhhhh</Font></Data></Cell> </Row> </Table> </Worksheet> </Workbook>
alors
pour l'exemple je le fait en string mais dans la fonction finale se sera fait en DOM dans un htmldocument object
maintenant je rajoute ce qui est en gras dans la sub
resultat
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7 ' la cellule au format HTML : " innerhtmls = Split(innerH.XML, Split(innerH.XML, ">")(0) & ">")(1) innerhtmls = Split(Replace(Replace(innerhtmls, "xmlns:html=""http://www.w3.org/TR/REC-html40""", ""), "html:", ""), "</Data")(0) If innerhtmls Like "*Font*" Then innerhtmls = "<FONT style=""fontfamily:" & Font_Name & ";" & "fontSize:" & Font_Size & ";" & "color:" & Font_Color & ";"">" & innerhtmls & "</FONT>" End If
on a ainsi un innerhtml bien nikelpropriété Globale du texte de la cellule :
Calibri 11 #000000
la cellule au format text :
gggtttttttttgggggggg gggggggggghhhhhhhhhhhhhh
la cellule au format HTML :
<FONT style="fontfamily:Calibri;fontSize:11;color:#000000;">g<B>g</B><Font Color="#00FFFF">gttt</Font><Font Color="#FF0000">t</Font><Font Face="Algerian" xmlns="urn:schemas-microsoft-com:office:excel" x:Family="Decorative" Color="#FF0000">tt</Font><Font Color="#FF0000">tt</Font><Font Color="#00FFFF">t</Font><B><Font Color="#00FFFF">g</Font><I><Font Size="16" Color="#00FFFF">gg</Font></I><Font Size="16" Color="#00FFFF">g</Font></B><Font Color="#00FFFF">gggg gggggggggghhhhhhhhhhhhhh</Font></FONT>
en vrai il y a une coquille
Font Size="16"
que je corrige déjà dans la fonction en dom car la propriété size de la balise font a pour limite "7" il faut remanier en CSS avec ppx
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
Non ça n'est pas très complexe.
Par contre, la méthode "propre" pour récupérer ton innerHtml est une véritable usine à gaz...
Garde la tienne!
Cordialement,
Franck
fonction finale avec (correction/conversion) des échelles fontsize
fonction
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10 Option Explicit Sub test() Dim cel As Range Dim doc As Object Set doc = CreateObject("htmlfile") 'creation de la table dans le doc en DOM 'blablabla Set cel = Sheets(1).Range("b3") Debug.Print htmltexte(cel, doc) End Sub
sauf méprise de ma part c'est bien moins lourd et moins de moilin que mes fonction "BYSPAN" et "textesylé" dans mes contributions concernant la convention d'une plage excel en html
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
30 Public Function htmltexte(cel, doc) Dim docxml As New MSXML2.DOMDocument 'Nouveau doc Xml Dim fontprop As Object, innerH, i#, ppx, Fonts As Object, Font_Name$, Font_Size$, Font_Color$, innerhtmls$ With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With With docxml If Not .LoadXML(Replace(cel.Value(xlRangeValueXMLSpreadsheet), "ss:Data", "Data")) Then err.Raise .parseError.ErrorCode, , .parseError.reason 'recherche des propriétés font Set fontprop = .getElementsByTagName("Font") Font_Name = fontprop(0).getAttribute("ss:FontName"): Font_Name = fontprop(1).getAttribute("ss:FontName") 'le font name Font_Size = fontprop(0).getAttribute("ss:Size"): Font_Size = fontprop(1).getAttribute("ss:Size") 'le font size 'fontcolor i = IIf(Not IsNull(cel.Font.Color), 1, 0) Font_Color = fontprop(i).getAttribute("ss:Color") 'innerhtml Set innerH = docxml.SelectSingleNode("/Workbook/Worksheet/Table/Row/Cell/Data") innerhtmls = Split(innerH.XML, Split(innerH.XML, ">")(0) & ">")(1) innerhtmls = Split(Replace(Replace(innerhtmls, "xmlns:html=""http://www.w3.org/TR/REC-html40""", ""), "html:", ""), "</Data")(0) If IsDate(cel.Value) Then innerhtmls = cel.Text 'si c'est une date elle sera affichée a l'identique qu'Excel With doc.createelement("FONT") .face = Font_Name: .Style.Color = Font_Color: .Style.FontSize = Font_Size * ppx: .innerhtml = Replace(innerhtmls, "xmlns:x=""urn:schemas-microsoft-com:office:excel", "") 'correction des font-sise dans le font global Set Fonts = .getElementsByTagName("FONT") For i = 0 To Fonts.Length - 1 If Fonts(i).Size <> "" Then Fonts(i).Style.FontSize = Fonts(i).Size * ppx: Fonts(i).Size = "" Next htmltexte = .outerhtml End With End With Set docxml = Nothing: Set fontprop = Nothing: Set innerH = Nothing End Function
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
Salut Patrick,
Je t'ai mis un petit
Pourquoi petit?
1- Parce que ton code omet (volontairement??) certaines propriétés des polices.
Quid de :
- Bold,
- Italic,
- Underline...
surement parce que tu n'en as pas besoin.
2- Parce que la cellule elle-même (interior (color, pattern), borders) est également omise.
Volonté de ta part ou oubli?
3- Je modifierais les lignes 16 à 18 comme ceci :
Plus de lignes de code, mais aussi plus logique : si cel est une date, tu t'évites 3 Split et 2 Replace...
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6 If IsDate(cel.Value) Then innerhtmls = cel.Text 'si c'est une date elle sera affichée a l'identique qu'Excel Else innerhtmls = Split(innerH.XML, Split(innerH.XML, ">")(0) & ">")(1) innerhtmls = Split(Replace(Replace(innerhtmls, "xmlns:html=""http://www.w3.org/TR/REC-html40""", ""), "html:", ""), "</Data")(0) End If
Sinon, question subsidiaire, comment gérerais tu toute une plage?
Une fonction qui génèrerai un tableau html à partir d'une feuille Excel, avec toutes les balises <table><tr><td> ??
Ceci étant dit, tu mérites ton
Cordialement,
Franck
re
bonjour pijaku o
ui effectivement les bold et italic global ne sont pas traités
je l'ai pourtant fait dans la version avec split sur extraitxml
il faut que j'ajoute effectivement une variable traité identiquement a fontname et font_size
cela est utile pour la même raison
soit tout est en gras/italic et le innerhtml dans data est en innertext soit ce n'est qu'une partie et la il y a des fonts dans data
pour la gestion d'une plage
oui je suppose que tu a pensé mettre toute la plage dans l'extraitxml mais malheureusement ce n'est pas possible
pourquoi
parce que dans l'extrait d'une plage les cellules vides ne sont même pas représentées(absentes )
donc pour la construction ca risque d'être un peu compliqué
j'ai donc gardé mes 2 solutions dont la première est une double boucle (rows/cell )
cela dit il serait intéressant de creuser sur les ID de cell dans l'extraitXML car dans un fichier xml solide loader avec excel les cellules sont a la bonne place
je suppose donc que les id sont numérotées en fonction de leur emplacement et/ou d'autre propriétés (je vois que ca )
pour économiser il est fort possible que je crée une seule fois l object xmldom dans la sub de création de la table et le manipule dans la fonction
pense tu que la création d'un object xmldom par fonction (htmltexte/bordure css /alignement css /) soit lourd
ou devrais je récupérer tout les properties que je souhaite dans une variable typé (globale) par exemple dans une seule fonction déclenché par cellules
POUR INFO
voila comment je créée ma table de base (sans style css) argument optional
teste la sans argument sauf la plage tu aura une table sans couleur et font style (c'est la base )
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
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44 Function Grille_To_Html_Base(plage, Optional interior_style As Boolean = False, Optional border_style As Boolean = False) Dim ppx, doc As Object, TR, TD, TABLO, i#, col#, cel With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With Set doc = CreateObject("htmlfile") With doc .body.innerhtml = "<table><TBODY></TBODY></table>" With .getElementsByTagName("TABLE")(0): .Style.Width = plage.Width * ppx: .Style.Color = "#000000": .Style.fontfamily = ThisWorkbook.Styles("Normal").Font.Name: .setattribute ("range:" & plage.Address) ' .Style.bordercollapse = "collapse": '.cellspacing = 0 End With Set TABLO = .getElementsByTagName("TBODY")(0) For i = 1 To plage.Rows.Count Set TR = .createelement("TR") TABLO.appendchild (TR) For col = 1 To plage.Columns.Count Set cel = plage.Cells(i, col) If .getElementById(Replace(cel.MergeArea.Address, "$", "")) Is Nothing Then Set TD = .createelement("TD") TD.ID = Replace(cel.MergeArea.Address, "$", "") TD.colspan = Range(TD.ID).Columns.Count: TD.rowspan = Range(TD.ID).Rows.Count TD.Style.Width = cel.MergeArea.Width * ppx TD.Style.Height = cel.MergeArea.Height * ppx TD.Style.Border = "1px solid #A9BCF5"' bordure xlnone d'office au depart If border_style = True Then bordure cel, TD End If If interior_style = True Then If cel.Value <> "" Then TD.innerhtml = text_stylé(cel, doc)' appel a la fonction text_stylé TD.Style.backgroundcolor = interiorcolor(cel)'appel a la fonction interiorcolor Else TD.innertext = cel.Text End If Debug.Print TD.Children.Length If TD.Children.Length > 0 Then TD.ChildNodes(0).Style.MarginLeft = 3 & "px" TR.appendchild (TD) End If Next Next Grille_To_Html_Base = .body.innerhtml End With End Function
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
En fait, l'id correspond à un style.
Donc tu ne peux pas t'en servir.
Par contre, tu as des index de ligne et de colonne...
Ici j'ai appliqué le style d'ID = s62 dans les cellules : I2, I4, J5, K2 et K5 et ai "injecté" le Range("I1:K5").
Résultat :
Par conséquent, tu n'as aucun de déterminer à coup sur qu'elle est la première ligne.
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 <Worksheet ss:Name="Feuil1"> <Table ss:ExpandedColumnCount="3" ss:ExpandedRowCount="5" ss:DefaultColumnWidth="60" ss:DefaultRowHeight="15"> <Row> 'pas d'index, mais pas forcément la première ligne ici il s'agit de la ligne 2 <Cell ss:StyleID="s62"/> 'pas d'index donc 1ère colonne sure <Cell ss:Index="3" ss:StyleID="s62"/> 'index = 3 donc 3ème colonne sure </Row> <Row ss:Index="4"> 'index = 4 donc 4ème ligne sure <Cell ss:StyleID="s62"/> 'pas d'index donc 1ère colonne sure </Row> <Row> 'pas d'index donc ligne suivante sure <Cell ss:Index="2" ss:StyleID="s62"/> 'index = 2 donc 2ème colonne sure <Cell ss:StyleID="s62"/> 'pas d'index donc colonne suivante : 3ème sure </Row> </Table> </Worksheet>
Si celle-ci est vide ou ne comporte pas de style, tu ne sais pas.
Par conséquent, il va te falloir imposer une contrainte, au choix :
> la première ligne du Range doit être une ligne d'entêtes,
> la première ligne du Range doit avoir une couleur particulière (même blanc...),
> encore mieux, lors du premier appel de ta fonction, tu vérifies si la cellule Plage(1, 1) à un style ou un texte, si ce n'est pas le cas, tu appliques ce code :
Ce code ne modifiera rien de ta feuille, mais va créer une nouvelle balise Style avec dedans : <interior/>.
Code : Sélectionner tout - Visualiser dans une fenêtre à part Plage.Cells(1, 1).Interior.Pattern = xlNone
C'est ce que je penses également.devrais je récupérer tout les properties que je souhaite dans une variable typé (globale) par exemple dans une seule fonction déclenché par cellules
Code surement plus propre...
Cordialement,
Franck
je vais regarder de plus prêt
pour les bolds et italic problème résolu
je n'ai pas vraiment besoins de le récupérer dans l'extraitXML
et si on réfléchi bien
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
30
31
32
33
34
35
36
37
38 Public Function htmltexte(cel, doc) Dim docxml As New MSXML2.DOMDocument 'Nouveau doc Xml Dim fontprop As Object, innerH, i#, ppx, Fonts As Object, Font_name$, Font_size$, Font_Color$, Font_bold$, Font_italic, innerhtmls$ With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With With docxml If Not .LoadXML(Replace(cel.Value(xlRangeValueXMLSpreadsheet), "ss:Data", "Data")) Then err.Raise .parseError.ErrorCode, , .parseError.reason 'recherche des propriétés font Set fontprop = .getElementsByTagName("Font") Font_name = fontprop(0).getAttribute("ss:FontName"): Font_name = fontprop(1).getAttribute("ss:FontName") 'le font name Font_size = fontprop(0).getAttribute("ss:Size"): Font_size = fontprop(1).getAttribute("ss:Size") 'le font size 'fontcolor i = IIf(Not IsNull(cel.Font.Color), 1, 0) Font_Color = fontprop(i).getAttribute("ss:Color") 'le font bold global Font_bold = "normal" If Not IsNull(cel.Font.Bold) Then Font_bold = "bold" 'le font italic global Font_italic = Null If Not IsNull(cel.Font.Italic) Then Font_italic = True 'innerhtml Set innerH = docxml.SelectSingleNode("/Workbook/Worksheet/Table/Row/Cell/Data") innerhtmls = Split(innerH.XML, Split(innerH.XML, ">")(0) & ">")(1) innerhtmls = Split(Replace(Replace(innerhtmls, "xmlns:html=""http://www.w3.org/TR/REC-html40""", ""), "html:", ""), "</Data")(0) If IsDate(cel.Value) Then innerhtmls = cel.Text With doc.createelement("FONT") .face = Font_name: .Style.Color = Font_Color: .Style.FontSize = Font_size * ppx: .innerhtml = IIf(Font_italic = True, "<i>", "") & Replace(innerhtmls, "xmlns:x=""urn:schemas-microsoft-com:office:excel", "") & IIf(Font_italic = True, "</i>", "") .Style.fontWeight = Font_bold 'correction des font-sise dans le font global Set Fonts = .getElementsByTagName("FONT") For i = 0 To Fonts.Length - 1 If Fonts(i).Size <> "" Then Fonts(i).Style.FontSize = Fonts(i).Size * ppx: Fonts(i).Size = "" Next htmltexte = .outerhtml End With End With Set docxml = Nothing: Set fontprop = Nothing: Set innerH = Nothing End Function
on pourrait faire dans la création du font
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4 if not isnull(cell.font.color) then propriété color de de la cellule ' sinon c'est le thisworkbook.styles("normal").font.color 'etc... 'l'extrait xml servirais simplement a récupérer le code innerhtml si il y aurais des balises FONT end if
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
Petite question parce que ça fait longtemps que je n'ai pas codé en html:css...
Comment injectes tu le style css dans une table html?
Exemple :
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 <!DOCTYPE html> <html> <head> <meta charset="utf-8" /> <style> td_1 {border: 1px solid black;} </style> <title>Test</title> </head> <body> <table> <tr> <th>Mois</th> <th>Année</th> </tr> <tr> <td>Janvier</td> <td css = td_1>2017</td> '??????????????????????? </tr> </table> </body> </html>
Cordialement,
Franck
en DOM et VB
exemple
en fait la ou une propriété en css s'écrit partie1-partie2 en dom elle s'écrit partie1partie2
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 with createobject("htmlfile") .body.innerhtml="<div></div>" set mondiv=.getelementsbytagname("DIV")(0) 'application des styles css mondiv.style.BackGroundColor="#ff0000" ou rgb(255,0,0) le font en couleur mondiv.style fontWeight="bold" le font bold OU ="normal" (tu peut mettre aussi des numéros 1,2,3,etc....) 'la bordure globale(les 4 coté d'un coup) mondiv.style.border="1px solid blue" 'bordure bleu 1 px d'épaisseur 'si tu veux différente bordure sur les coté 'exemple 'mondiv.style.borderleft="...pareil que pour un globale) 'mondiv.style.bordertop="...pareil que pour un globale) 'mondiv.style.borderright="...pareil que pour un globale) 'mondiv.style.borderbottom="...pareil que pour un globale) end with
et pour l'applique c'est element.style.propriétécss="......"
element.style
fontsize =taille
fontfamily = font name
color=fontcolor
fontWeight=épaisseur de l'écriture(bold/normale/chiffre)
fontitalic=italic rarement utilis2 puisque balise "<em>" ou "<i>"
ETC....
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
Ouais.
Ok.
Je me fourvoyais alors.
En fait, lorsque tu regardes le docxml.xml, tu as :
> dans le <Styles> : le css
> dans la <table> : le html
Mais ça ne t'aide pas dans la piste que tu suis.
Cordialement,
Franck
oui on a tout mais dans un format xml ,mais on peu tout récupérer
ca reste quand même une solution moins lourde que mon moulin BYSPAN ou textestylé(version 2016)
apres si on devrait pas se casser la tete puisque tu veux tout
voici la version avec split que j'ai finalisé
dans cet exemple j'ai adopter un autre raisonnement pour le( bold ,underline et strikeghout et italic par defaut)a savoir pas en css mais en dom c'est a dire en balise "<b> ,<u>,<i>,<strike>"
je ne converti plus les fontsize aussi je reste en point je fait juste sauter les "size" des font car la limite est "7" donc je passe en stylecss le .size mais reste en points
je te laisse regarder
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
30
31
32
33
34 Option Explicit Sub test6() Dim doc As Object Set doc = CreateObject("htmlfile") Debug.Print texthtml2([A1], doc) End Sub Function texthtml2(cel, doc) Dim EXTRAITXML, workBstyle As Object, Fname$, Fsize$, fbold$, Fcolor$, Fitalic$, InnerH$, InnerHtmls$, FunderL$, Fbarré$, i#, Fonts As Object EXTRAITXML = Replace(cel.Value(xlRangeValueXMLSpreadsheet), "ss:Data", "Data") Set workBstyle = ThisWorkbook.Styles("normal") Fname = IIf(Not IsNull(cel.Font.Name), cel.Font.Name, workBstyle.Font.Name) Fsize = IIf(Not IsNull(cel.Font.Size), cel.Font.Size, workBstyle.Font.Size) fbold = IIf(Not IsNull(cel.Font.Bold), "<B>", "") Fcolor = IIf(Not IsNull(cel.Font.Color), Split(Split(EXTRAITXML, "ss:Color=""")(2), Chr(34))(0), "#000000") Fitalic = IIf(Not IsNull(cel.Font.Italic), "<i>", "") FunderL = IIf(cel.Font.Underline > 0, "<u>", "") Fbarré = IIf(cel.Font.Strikethrough, "<STRIKE>", "") If IsDate(cel.Value) Then InnerH = cel.Text Else InnerH = Split(EXTRAITXML, "<Data")(1) InnerHtmls = Replace(Split(Split(InnerH, Split(InnerH, ">")(0) & ">")(1), "</Data>")(0), "html:", "") End If With doc.createelement("FONT") With .Style: .fontfamily = Fname: .FontSize = Fsize & "pt": .Color = Fcolor:: End With .innerhtml = fbold & Fbarré & Fitalic & FunderL & InnerHtmls & IIf(FunderL <> "", "</u>", "") & IIf(Fitalic <> "", "</i>", "") & IIf(Fbarré <> "", "</STRIKE>", "") & IIf(fbold <> "", "</b>", "") Set Fonts = .getElementsByTagName("FONT") For i = 0 To Fonts.Length - 1 If Fonts(i).Size <> "" Then Fonts(i).Style.FontSize = Fonts(i).Size & "pt": Fonts(i).Size = "" Next texthtml2 = .outerhtml End With End Function
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
oupss!! non tu te fourvoyais pas
tu parle du style outline tandis que moi je style inline (style dans le outertext de l'élément)
c'est réalisable aussi je le fait dans ma contribution
j'extrais le style inline et le met dans la balise style global
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager