dieser Script bereitet mir Probleme:
Sub SearchBot1()
Dim IE As New SHDocVw.InternetExplorer, pfad As String, sh As Shape, Bild As String, cl As _
Range, yAchse As String, xLink As String, xAchse As String, Preis As Object, Preis2 As Object
Dim Zelle As String
Dim ModelNummerKnoten1 As Object, ModelNummer1 As Object, ModelNummerKnoten2 As Object, _
ModelNummer2 As Object
IE.Visible = False
yAchse = 4
xLink = "K"
START:
yAchse = yAchse + 1
pfad = "ActiveSheet.Range(xAchse & yAchse)"
Do Until Cells(yAchse, 11).Value " " Then GoTo START
IE.navigate ActiveSheet.Range(xLink & yAchse)
Do While IE.Busy = True Or IE.readyState 4: DoEvents: Loop
'Bild
xAchse = "B"
For Each pic In IE.document.getElementsByClassName("pic")
Set cl = Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
Set sh = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 100, 100, 100, 100.25)
With sh
On Error Resume Next
.Fill.UserPicture pic.src
.LockAspectRatio = msoFalse
.Width = cl.Width
.Height = cl.Height
.top = cl.top
.Left = cl.Left
End With
cl.Value = "x"
Set cl = Nothing
Set sh = Nothing
Set pic = Nothing
If Application.Wait(Now + TimeValue("0:00:01")) Then
End If
Next
Check = yAchse + 1
If Cells(Check, 11).Value
Er soll z.B. von dieser Webseite: https://yctrg.en.alibaba.com/product/60330208447-802114330/Promotional_USB_Drive.html?spm=a2700.8304367.prewdfa4cf.1.5f5d7debDgd02ODas Bild rauskopieren, was auch manchmal funktioniert, doch manchmal kopiert er mir in Excel einfach 10 blaue Kästchen hintereinander und dann erst das Bild. Kann mir das Problem jemand beheben?
Freue mich auf eure Antworten