Discussion :

[Oliv-]

Bonjour,
Dans une feuille je souhaite insérer des données provenant d'une page asp sur un internet.

Soit manuellement par le menu Données/A partir du Web.
Soit parce cette MAcro

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub testweb2()
    Set shFirstQtr = Worksheets("Web2")
    Set qtQtrResults = shFirstQtr.QueryTables _
                       .Add(Connection:="URL;http://www2.transports.equipement.gouv.fr/registres/marchandises/1.htm", _
                            Destination:=shFirstQtr.Cells(1, 1))
    With qtQtrResults
        .PreserveFormatting = True
        .WebFormatting = xlNone
        .WebPreFormattedTextToColumns = True
        .BackgroundQuery = False
        .Refresh BackgroundQuery:=False
    End With
End Sub

Cela fonctionne dans les 2 cas sauf pour certaines données qui commencent par un zéro significatif mais qui arrivent converties en Nombre
comme les codes postaux pour les département 01,02,03,04,05,06,07,08,09...

donc au lieu d'avoir : 02800 (affichage web) j'ai 2800 dans ma cellule

J'ai bien paramétré ma colonne en "Texte" au préalable , avec l'option "Conserver le format des cellules" dans les propriétés de la plage de données externe

mais je ne trouve pas comment forcer le format arrivant en texte ?

[Marc-L]

Bonjour,

voir dans les propriétés de l'objet QueryTable s'il y en a une référente au problème …

Sinon cela se règle facilement par macro en appliquant sur la plage des cellules concernées le format texte

puis .Formula = .Formula …

__________________________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …

[Oliv-]

Bonjour Marc,

Je n'ai pas trouvé dans les propriétés de l'objet QueryTable !

Pour des codes postaux c'est simple de rajouter un zéro devant s'il y a moins de 5 caractères, pour les SIRET aussi d'ailleurs, là où c'est plus délicat c'est quand tu ne sais pas si il faut un zéro devant ou pas !

Dans le cas qui m'occupe il s'agit de numéros de contrats.

[Marc-L]

Donc il ne te reste plus qu'à appliquer l'astuce de mon précédent message par macro sur la plage des cellules concernées …

[Oliv-]

Je te répond par l'exemple suivant
dans ma base mes contrats peuvent être : "028235933" , "375034201" , "27832496"
et j'obtiendrai dans excel : 28235933 , 375034201 , 27832496

mais il ne faut un zéro devant que pour le premier !

[Marc-L]

Dans le lien initial, aucun numéro de contrat ! Mon astuce résout bien l'affichage du Siret …

[Oliv-]

Effectivement, mais ce site internet était juste pour l'exemple, mes données proviennent d'un intranet !

[Marc-L]

Autres pistes dans cette discussion en parcourant les éléments de la table et dans cette autre discussion (clipboardData) …


__________________________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …

[patricktoulon]

Bonjour Oliv _ maintenant

si tu utilise le clipboardata effectivement la chaine sera pris en tant que string

par contre si tu utilise une variable tableau tu pourrais boucler sur les items et vérifier la présence du zero

Re
il est vrai que ca n'est pas évident

comme ca a l'arrache ca donne ca avec IE

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
Sub test_avec_IE()
debut = Time
Cells = ""
URL = "http://www2.transports.equipement.gouv.fr/registres/marchandises/1.htm"
Set ie = CreateObject("internetexplorer.application")
ie.navigate URL
ie.Visible = True
Do: DoEvents: Loop Until ie.readystate = 4
 latable = ie.document.getelementsbytagname("table")(6).outerhtml
  With CreateObject("htmlfile")
  .write latable
  faire = .ParentWindow.clipboardData.SetData("text", .getelementsbytagname("table")(0).outerhtml)
    With Sheets(1)
        .Cells(1, 1).Select
        .Paste
    End With
  faire = .ParentWindow.clipboardData.ClearData("text")
  End With
MsgBox "la requete a demaré a : " & debut & " et a terminé a : " & Time & vbCrLf & "elle aura donc duré : " & Format(Time - debut, "nn:ss") & " secondes"
Columns("B:B").NumberFormat = "0"
Application.ScreenUpdating = True
 
ie.Quit
End Sub

sinon avec une requette avec l'object "microsoftxmlhttp"

ca donne ca

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
Sub test_avec_microsoftxmlhttp()
URL = "http://www2.transports.equipement.gouv.fr/registres/marchandises/1.htm"
Set demandefichier = CreateObject("Microsoft.XMLHTTP")
demandefichier.Open "POST", URL, False
demandefichier.send
  With CreateObject("htmlfile")
  .write demandefichier.responsetext
 faire = .ParentWindow.clipboardData.SetData("text", .getelementsbytagname("table")(6).outerhtml)
 
 With Sheets(1)
        .Cells(1, 1).Select
        .Paste
    End With
faire = .ParentWindow.clipboardData.ClearData("text")
End With
Columns("B:B").NumberFormat = "0"
Application.ScreenUpdating = True
End Sub

[Oliv-]

Bonjour Patrick et Marc Et les autres
C est dommage que cette fonction intégrée ne renvoi pas les données telles qu elles sont sur le site
je vais tester vos solutions

Le besoin qui m'a fait revenir la dessus utilise une page asp que j'ai développé croyez vous que je puisse faire autrement genre générer une page xml qui je pense contiendrait le format des données ?

[Oliv-]

Re
il est vrai que ca n'est pas évident

comme ca a l'arrache ca donne ca avec IE
...
sinon avec une requette avec l'object "microsoftxmlhttp"

ca donne ca

...

Bonjour PATRICK,


Désolé mais les 2 codes interprètent le texte en nombre !, la donnée la plus parlante à ce sujet étant le code postal

Columns("B:B").NumberFormat = "0" permet effectivement de supprimer le format scientifique.

Ne peut on pas faire faire un copier/coller avec clipboardData comme manuellement ?

Car lorsque l'on fait manuellement on a 2 options de collage dans excel "Conserver la mise en forme source" et "Respecter la mise en forme de destination"

alors que là on a juste "Conserver uniquement le texte"

Avec ce code là cela fonctionne 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
Sub Demo()
    URL = "http://www2.transports.equipement.gouv.fr/registres/marchandises/3.htm"
    Set ws = Worksheets("web3")
 
    ws.Columns("A:F").NumberFormat = "@"
    With CreateObject("InternetExplorer.Application")
        .Visible = True
        .Navigate URL
        Do: Loop Until .readyState = 4
 
        Set MyRows = .document.getelementsbytagname("table")(6).getelementsbytagname("table")(2).Rows
        With MyRows
            For R& = 1 To .Length
                With .Item(R - 1).Cells
                    For C& = 1 To .Length: ws.Cells(R, C).Value = .Item(C - 1).innerText: Next
                End With
            Next
        End With
 
        .Quit
    End With
    End
End Sub

Avec cet URL vous verrez qu'il peut y avoir des SIRET qui commencent par des Zéros !

[Oliv-]

Re,
A force de chercher, on fini par trouver...
Voici une solution qui permet de définir un type de données dans la page ASP, que Excel interprète ensuite correctement avec une webquery

http://www.cnblogs.com/aji88/archive...9/2076162.html

The solution? The mso-number-format style attribute, to be put on table cells (<td>). Several number formats are available. These are some of the more common:

mso-number-format:\@
text
mso-number-format:"0\.000"
3 decimals
mso-number-format:\#\,\#\#0\.000
comma separators (and 3 decimals)
mso-number-format:"mm\/dd\/yy"
Date format
mso-number-format:"d\\-mmm\\-yyyy"
another date format
mso-number-formatercent
percent
'mso' stands for Microsoft Office, so these formatting hints will hold if table data is imported into any Office product.

To solve our initial problem -- not dropping leading zeros from account numbers, we used the text format in a CSS style sheet:

td.accountnum
{mso-number-format:\@}

Then, on the the actual table, just use the accountnum class:

<td class="accountnum">01070000<td>

Donc j'ai modifié ma page asp de la sorte :

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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
<!DOCTYPE html>
<%@ Language=VBScript %>
<%
Set Conn = Server.CreateObject("ADODB.Connection")
conn.CursorLocation = 2
Conn.open Application("CS_DATA")
Set RS = Server.CreateObject("ADODB.recordset")
Server.ScriptTimeout = 300
 
%>
<HTML>
<HEAD>
<style type="text/css">
td.accountnum
  {mso-number-format:\@}
</style>
<TITLE>Export</TITLE>
</HEAD>
<body bgcolor="#FFFFFF">
 
<%
'On recupère les parametres =============================================================
sContrat = Request("Contrat")
sErr=""
 
        Sql = "SELECT      ctr.CTR_REF AS Contrat 
        Sql = Sql & " FROM rve.contrat@RVE_DBLINK ctr "
        Sql = Sql & " WHERE CTR.CTR_REF IN ('" + sContrat + "') "
 
	rs.Open sql, conn
 
%>
<table border="1" width="100%" style="border-collapse: collapse" name="Donnees" id="Donnees">
	<tr>
	<%for each x in rs.Fields
    response.write("<th FILTER=ALL>" & x.name & "</th>")
	next %>
	</tr>
 
<% do until rs.EOF%>
    <tr>
    <%for each x in rs.Fields%>
      <% 
	   select case x.Type
				case 5,131,139 'numérique
				%>
					 <td style="empty-cells: show">
				<%case 129,130,200,201,202,203 'texte 
					if IsDate(X.Value) then
				%>
					 <td style="empty-cells: show">
				<%	else
				%>
					 <td class="accountnum" style="empty-cells: show">
				<%	end if
				case else
				%>	 <td style="empty-cells: show"> <%
			end select
			Response.Write(x.value)%></td>
    <%next
    rs.MoveNext%>
    </tr>
<%loop
rs.close
conn.close
%>
</table>
 
</body>
</html>

Vous l'avez bien compris c'est bad pour des pages ASP qu'on ne maîtrise pas !

[Oliv-]

Alors voici une autre solution pour un copier coller idem au copier coller manuel (source)

Il faut un FORMULAIRE sur lequel on insère un contrôle WEBBROWSER + un BOUTON + UN TEXTBOX

dans l'exemple on peut cliquer directement sur le bouton

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
45
46
47
48
49
 
 
Option Explicit
 
Dim Body As HTMLBody
 
Private Sub CommandButton1_Click()
    Dim Text1 As String
    Dim b() As Byte
    Dim t As Long
 
 
    CommandButton1.Enabled = False
 
    ' This opens the file specified in the URL text box
    'WebBrowser1.Document.Body.innerHTML = "<h1>Testing</h1><table border=1 cellspacing=0><tr><td>Test1</td><td>Test2</td></tr></table>"
    ' This loads the opened file into the RichTextBox control
    If TextBox1.Value <> "" Then
      WebBrowser1.Navigate2 Trim(TextBox1.Value)
    Do While WebBrowser1.Busy = True
        DoEvents
    Loop
    End If
 
    Set Body = WebBrowser1.Document.Body
    Text1 = Body.innerText
 
    WebBrowser1.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
    WebBrowser1.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT
 
    CommandButton1.Enabled = True
    ActiveSheet.Columns("A:D").NumberFormat = "@"
    ActiveSheet.Range("a1").Select
 
        ActiveSheet.PasteSpecial Format:="HTML", link:=False, DisplayAsIcon:= _
        False, NoHTMLFormatting:=True
    Unload Me
End Sub
 
Private Sub TextBox1_Change()
 
End Sub
 
Private Sub UserForm_Initialize()
    WebBrowser1.Navigate2 "http://www2.transports.equipement.gouv.fr/registres/marchandises/3.htm"
    Do While WebBrowser1.Document Is Nothing
        DoEvents
    Loop
End Sub

[patricktoulon]

Bonjour Oliv-
J avoue que je suis perplexe devant ce déploiement de ressource pour une simple table html

un code postal contient forcement 5 caractères numériques
étant donné que la copie supprime le "0" devant le code postal un simple test sur le len de la cellule suffit

parti de la je vois pas pourquoi se compliqué la vie


j'ai testé avec les 2 URLs
Avec IE

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
Sub test_avec_IE()
debut = Time
Cells.Clear
'URL = "http://www2.transports.equipement.gouv.fr/registres/marchandises/1.htm"
URL = "http://www2.transports.equipement.gouv.fr/registres/marchandises/3.htm"
Set ie = CreateObject("internetexplorer.application")
ie.navigate URL
ie.Visible = True
Do: DoEvents: Loop Until ie.readystate = 4
  latable = ie.document.getelementsbytagname("table")(9).outerhtml
  With CreateObject("htmlfile")
  .write latable
  faire = .ParentWindow.clipboardData.SetData("text", .getelementsbytagname("table")(0).outerhtml)
    With Sheets(1)
        .Cells(1, 1).Select
        .Paste
    End With
  faire = .ParentWindow.clipboardData.ClearData("text")
  End With
    For i = 2 To Selection.Rows.Count
    Cells(i, 1).NumberFormat = "0"
    If Len(Cells(i, 3)) = 4 Then Cells(i, 3).NumberFormat = """0""0"
    Next
Application.ScreenUpdating = True
MsgBox "la requete a demaré a : " & debut & " et a terminé a : " & Time & vbCrLf & "elle aura donc duré : " & Format(Time - debut, "nn:ss") & " secondes"
'ie.Quit
End Sub

ou avec l'object XMLHTTP

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
 
Sub test_avec_microsoftxmlhttp()
'URL = "http://www2.transports.equipement.gouv.fr/registres/marchandises/1.htm"
URL = "http://www2.transports.equipement.gouv.fr/registres/marchandises/3.htm"
Set demandefichier = CreateObject("Microsoft.XMLHTTP")
demandefichier.Open "POST", URL, False
demandefichier.send
  With CreateObject("htmlfile")
  .write demandefichier.responsetext
 faire = .ParentWindow.clipboardData.SetData("text", .getelementsbytagname("table")(9).outerhtml)
 
 With Sheets(1)
        .Cells(1, 1).Select
        .Paste
    End With
faire = .ParentWindow.clipboardData.ClearData("text")
End With
    For i = 2 To Selection.Rows.Count
    Cells(i, 1).NumberFormat = "0"'on met le format de la cellule en colonne A en numero entier 
    If Len(Cells(i, 3)) = 4 Then Cells(i, 3).NumberFormat = """0""0"' on ajoute le zero manquant si necessaire 
    Next
    Application.ScreenUpdating = True
End Sub

non vraiment je ne vois pas

dans ces deux exemples je n'ai gardé que la table qui t'intéresse avec ces "TH"(titre de colonne)a l'inverses de mes 2 précédentes versions

je suppose que ce sera plus facile pour toi

[Oliv-]

Bonjour Patrick,
Comme je l’écrivais à Marc, l'URL indiquée dans mon exemple, était juste pour pouvoir reproduire le problème, mes données RÉELLES proviennent d'un intranet et n'ont pas de règles de nombres de caractères comme les codes postaux (Français) ou les SIRET, qui permettent de corriger après importation.

Mais que penses tu de mes solutions ?

[patricktoulon]

Bonjour Oliv-

oui effectivement pré formater la page asp est une solution c'est le Webbroser etc..; qui me gène ca fait un peu beaucoup surtout que cet object est diffèrent sur chaque version de windows donc selon le system d'exploitation "Object manquant!!!!!!!"


si la règle principale est le zero mais que dans ton cas réel tu ne peut pas déterminer le len alors a la place du presse papier utilise plutôt une variable tableau pour la copie et un control sur le tableau lui même pour ajouter ou pas les zéros

je vais regarder ca de plus prêt

dans le code du faux document html (createobject("htmlfile")) on peut insérer du code pour le style(css) peut être que l'on peut integrer ton code de pré formatage


ou même autrement et encore plus simple

ajouter un symblole (celui que tu veux) dans chaque td avec un zero devant ,toujours dans le faux document

et après le paste faire un replace en plus de la fonction numberformat

en ce qui concerne le XMLHTTP il y a aussi le header request aussi qui peut paramétrer la page

[patricktoulon]

Re
Voila c'est bien ce que je pensais

il n'est pas nécessaire de faire une usine a gaz en html ou en vba pour arriver a ce que tu veux

le principe
toujours pareil
1 récupérer le code outerhtml de la table
2 intégrer ce code dans le faux document
3 boucler sur les td et tester le 1 caractères est un zero si oui ajouter un "#"devant
4 paste
5 mettre la colonne a en numberformat "0"
6 boucler sur toutes les cellules et tester la presence du "#"
si oui mettre en numberformat "00" et suprimer le "#"
en fin de boucle pour les cellules qui ont simplement un zero comme value mettre zero

et voila le tour est joué

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
 
Sub test_avec_IE_2()
debut = Time
Cells.Clear
'URL = "http://www2.transports.equipement.gouv.fr/registres/marchandises/1.htm"
URL = "http://www2.transports.equipement.gouv.fr/registres/marchandises/3.htm"
Set ie = CreateObject("internetexplorer.application")
ie.navigate URL
ie.Visible = True
Do: DoEvents: Loop Until ie.readystate = 4
  latable = ie.document.getelementsbytagname("table")(9).outerhtml
  With CreateObject("htmlfile")
  .write latable
  Set tabletd = .getelementsbytagname("td")
  For Each cel In tabletd
  If Left(cel.innertext, 1) = 0 Then cel.innertext = "#" & cel.innertext
  Next
 
  faire = .ParentWindow.clipboardData.SetData("text", .getelementsbytagname("table")(0).outerhtml)
    With Sheets(1)
        .Cells(1, 1).Select
        .Paste
    End With
  faire = .ParentWindow.clipboardData.ClearData("text")
  End With
  Columns("A:A").NumberFormat = "0"
  For Each cel In Selection.Cells
     If InStr(cel, "#") > 0 Then
    cel.Value = Replace(cel.Value, "#", "")
   cel.NumberFormat = """0""0"
     End If
  If cel.Value = 0 Then cel.NumberFormat = "0"
 
    Next
   Application.ScreenUpdating = True
MsgBox "la requete a demaré a : " & debut & " et a terminé a : " & Time & vbCrLf & "elle aura donc duré : " & Format(Time - debut, "nn:ss") & " secondes"
ie.Quit
End Sub

si tu préfère l'object XMLHTTP adapte la boucle sur les cells et c'est tout

[Oliv-]

Merci Patrick,
La méthode du paragraphe #13 me semble plus simple.
Mais je garde celle-ci en cas de besoin.

[patricktoulon]

tu es sérieux la !

plus simple !????

surtout que le innertext dans la cellule supprime automatiquement le zero

[patricktoulon]

effectivement je viens de l'essayer je n'avais pas vu le formatnumber"@"

mais ca implique un traitement difficile par la suite (numeric pas numeric)

tien voila un exemple avec un tableau

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
Sub test_avec_IE_3()
Dim tablo() As Variant, nbligne As Long, nbcol As Long
debut = Time
Cells.Clear
'URL = "http://www2.transports.equipement.gouv.fr/registres/marchandises/1.htm"
URL = "http://www2.transports.equipement.gouv.fr/registres/marchandises/3.htm"
Set ie = CreateObject("internetexplorer.application")
ie.navigate URL
ie.Visible = True
Do: DoEvents: Loop Until ie.readyState = 4
  latable = ie.document.getelementsbytagname("table")(9).outerhtml
  With CreateObject("htmlfile")
  .write latable
  Set ligne = .getelementsbytagname("tr")
  nbligne = ligne.Length
  nbcol = ligne(1).Children.Length
  ReDim tablo(nbligne, nbcol)
 
 Columns("A:F").NumberFormat = "@"
  For a = 0 To nbligne - 1
   For e = 0 To nbcol - 1: tablo(a, e) = ligne(a).Children(e).innerText: Next
  Next
 End With
  Range("A1").Resize(nbligne, nbcol) = tablo
   Application.ScreenUpdating = True
MsgBox "la requete a demaré a : " & debut & " et a terminé a : " & Time & vbCrLf & "elle aura donc duré : " & Format(Time - debut, "nn:ss") & " secondes"
ie.Quit
End Sub