Discussion :

[asphalte01]

Bonjour,

j'ai une macro Excel qui affiche une page web dans un classeur et récupère les images présentent dedans. Elle fonctionne très bien dans 2003 mais sur 2007 et 2010 c'est le code source de la page qui va dans le classeur.

Sauriez vous si il faut activer une option dans Excel pour que le se soit la page qui soit chargée et non le code source ?

Merci d'avance pour vos réponses.

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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
Private Sub Recherche_Click()
Dim strURL As String
Dim Manga As String
ListBox1.Clear
 
Manga = Replace(TextBox1.Text, " ", "-")
Tome = TextBox2.Text
 
'strURL = "http://www.google.fr/vol-4?as_q=&hl=fr&tbm=isch&btnG=Recherche+Google&as_epq=" & Manga & " " & Tome & "&as_oq=&as_eq=&imgtype=&imgsz=&imgw=&imgh=&imgar=&as_filetype=&imgc=&as_sitevol-4=&as_rights=&safe=images&as_st=y"
If TextBox2.Text <> "" Then
    strURL = "http://www.manga-news.com/index.php/manga/" & Manga & "/vol-" & Tome
    Workbooks.Open Filename:=strURL
    Sheets("vol-" & Tome).Name = "search"
Else
    strURL = "http://www.manga-news.com/index.php/manga/" & Manga
    Workbooks.Open Filename:=strURL
    Sheets(Manga).Name = "search"
    TextBox2.Text = 1
End If
 
Workbooks.Application.Visible = True
 
Dim img As Object
Dim i As Variant
Dim nomimg As Variant
Dim fich As Variant
 
For Each img In Worksheets(1).ChartObjects 'ou Worksheets("nom").Shapes
 
    i = i + 1
    Worksheets(1).ChartObjects(i).Activate
    nomimg = ActiveChart.Name
    fich = ThisWorkbook.Path & "\Images_Temp\"
    ' On lance la procédure d'export
    ActiveChart.Export Filename:=fich & nomimg & ".gif", FilterName:="GIF"
 
 
Next
 
CopierImageEtEnregistrerEnJpg
 
'Mise en liste des images trouvées
 
Dim FSO As Object, Dossier As Object, NomDossier
Dim Files As Object, File As Object
 
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    NomDossier = ThisWorkbook.Path & "\Images_Temp\"
    If NomDossier = "" Then Exit Sub
    Set Dossier = FSO.GetFolder(NomDossier)
 
 
    Set Files = Dossier.Files
    If Files.Count <> 0 Then
        For Each File In Files
            ListBox1.AddItem (File.Name)
        Next
    End If
 
ListBox1.Enabled = True
 
i = 1
 
While Left(Worksheets("search").Cells(i, 1), 4) <> "Avis"
 
    i = i + 1
 
Wend
 
TextBox3.Text = Sheets("search").Cells(i + 2, 1)
 
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
 
Workbooks.Application.Visible = True
 
 
End Sub
 
Sub CopierImageEtEnregistrerEnJpg()
Dim NomFich
Dim i, j As Variant
Dim shape As shape
Dim graphe As Chart
Dim FL1 As Worksheet
    Set FL1 = Worksheets("search")
    FL1.Select
    'Range("A1").Select
    j = 2
 
    For Each shape In FL1.Shapes
 
    If j <= 10 Then
 
    NomFich = ThisWorkbook.Path & "\Images_Temp\Image" & j & ".gif"  'Nom de la "future" image
    FL1.Shapes(j).Select 'sélection de l'image
    Selection.Copy 'ou .cut
    For i = 1 To 50000 'laisse au système le temps de copier l'image
        DoEvents
    Next
    Set graphe = Charts.add 'insertion d'un graphe vide
    graphe.ChartType = xlLineMarkers 'ou autre...
    graphe.SetSourceData Source:=Sheets("search").Range("A1")
    graphe.Location Where:=xlLocationAsObject, Name:="search"
 
    'La difficulté sera peut-être dans le redimensionnement du graphe
    FL1.ChartObjects(1).Height = FL1.Shapes(j).Height
    FL1.ChartObjects(1).Width = FL1.Shapes(j).Width 'largeur du graphe
    DoEvents
 
    FL1.ChartObjects(1).Select 'sélection du graphe
    ActiveChart.ChartArea.Select '
    ActiveChart.Paste 'collage de l'image dans le graphe
    DoEvents
 
    DoEvents
    ActiveChart.Export Filename:=NomFich, FilterName:="GIF"    'Enregistrement de l'image
    DoEvents
 
 
    FL1.ChartObjects(1).Select
 
    With Selection
    .Delete
    End With
    'Selection.Delete 'suppression du graphe avec son image
 
    j = j + 1
 
    End If
 
 Next
 
    Set FL1 = Nothing
 
End Sub

[asphalte01]

Si personne n'a d'idée, auriez vous une autre solution pour récupérer les images sur une pages web ?