<b>Wert aus Internetseite kopieren </b>

Bild

Betrifft: <b>Wert aus Internetseite kopieren </b>
von: Stephan
Geschrieben am: 21.06.2015 20:29:28

Hallo liebe VBA Freunde
Ich importiere einen Datenwert der sich laufend ändert aus einer Webseite. Das funktioniert auch. Dieser Wert wird immer in Zelle 52 im Worksheet eingefügt. Ich habe ein Makro erstellt, wo dieser Wert bei Änderung in Tabelle2 kopiert wird und da gibt es ein Problem.
Wenn ich den Wert von Hand mit Enter in die Zelle 52 eintrage, wird er in Tabelle2 kopiert. Wenn er aber über die Aktualisierung der Webseite geändert wird passiert gar nix.
Ich müsste also der Zelle sagen können, dass sie dieses Makro ausführen soll wenn sich der Wert darin ändert. Habe es mit "SendKey {enter}" schon versucht, aber das geht leider auch nicht.
Ich wäre über ein Lösungsvorschlag megafroh.
Hier der Code des Makros:


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$52" Then
  Tabelle1.Range("A52").Copy
  Tabelle2.Range("A" & (Tabelle2.Cells(Rows.Count, 1).End(xlUp).Row) + 1).PasteSpecial
End If
End Sub


Bild

Betrifft: AW: <b>Wert aus Internetseite kopieren </b>
von: Sepp
Geschrieben am: 21.06.2015 21:02:15
Hallo Stephan,
der refresh löst kein "normales" Event aus.
Man kann aber mit einer eigenen Klasse nachhelfen.
Mal so ins Blaue.

' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Call Tabelle1.Terminate_Class
End Sub


Private Sub Workbook_Open()
  Call Tabelle1.Init_Class
End Sub


' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private WithEvents mobjQueryTable As clsQueryTable

Friend Sub Init_Class()
  Set mobjQueryTable = New clsQueryTable
  Set mobjQueryTable.prpQueryTable = QueryTables(1)
End Sub


Friend Sub Terminate_Class()
  Set mobjQueryTable = Nothing
End Sub


Private Sub mobjQueryTable_Refresh(blnRefreshReady As Boolean)
  If blnRefreshReady Then
    Tabelle2.Range("A" & (Tabelle2.Cells(Rows.Count, 1).End(xlUp).Row) + 1) = Tabelle1.Range("A52").Value
  End If
End Sub


' **********************************************************************
' Modul: clsQueryTable Typ: Klassenmodul
' **********************************************************************

Option Explicit

Private WithEvents mobjQueryTable As QueryTable

Public Event Refresh(blnRefresh As Boolean)

Friend Property Set prpQueryTable(objQueryTable As QueryTable)
  Set mobjQueryTable = objQueryTable
End Property


Private Sub Class_Terminate()
  Set mobjQueryTable = Nothing
End Sub


Private Sub mobjQueryTable_AfterRefresh(ByVal Success As Boolean)
  RaiseEvent Refresh(True)
End Sub


Private Sub mobjQueryTable_BeforeRefresh(Cancel As Boolean)
  RaiseEvent Refresh(False)
End Sub


Gruß Sepp


Bild

Betrifft: Der Code ist übrigens..
von: Sepp
Geschrieben am: 21.06.2015 21:03:45
... von Nepumuk!
https://www.herber.de/forum/archiv/1208to1212/1210269_Auf_Fertigstellung_der_Aktualisierung_warten.html#1210368

Gruß Sepp


Bild

Betrifft: AW: Der Code ist übrigens..
von: Stephan
Geschrieben am: 21.06.2015 22:46:14
Lieber Sepp, mit Deiner Klasse funktioniert es, hab 10000 Dank :-)

 Bild

Beiträge aus den Excel-Beispielen zum Thema "<b>Wert aus Internetseite kopieren </b>"