Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Grafischen Webcounter zeilenweise einlesen

Gruppe

OnTime

Problem

Excel/VBA-Beispiel: Grafischen Webcounter zeilenweise einlesen

Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn zwei Schaltflächen zu.


ClassModule: DieseArbeitsmappe

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   Call StopCounter
End Sub

StandardModule: Modul1

Public Const gsMacro As String = "UpdateCounter"
Public gdNextTime As Double

Private Declare Function URLDownloadToFile Lib "urlmon" _
   Alias "URLDownloadToFileA" ( _
   ByVal pCaller As Long, _
   ByVal szURL$, _
   ByVal szFileName$, _
   ByVal dwReserved As Long, _
   ByVal lpfnCB As Long) As Long
   

Sub StartCounter()
   Dim iIntervall As Integer
   iIntervall = Range("C1").Value
   gdNextTime = Now + TimeSerial(0, 0, iIntervall)
   Application.OnTime earliesttime:=gdNextTime, _
      procedure:=gsMacro, schedule:=True
End Sub

Sub StopCounter()
   On Error Resume Next
   Application.OnTime earliesttime:=gdNextTime, _
      procedure:=gsMacro, schedule:=False
End Sub

Private Sub UpdateCounter()
   Dim pct As Picture
   Dim lResult As Long
   Dim sUrl$, sLocalFile$
   Dim iRow As Integer
   Dim sFile As String
   iRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
   Cells(iRow, 1).Select
   sUrl = "http://s89.gratiscounter.de/hit.cgi?24374"
   sFile = Application.DefaultFilePath & "\counter.gif"
   lResult = URLDownloadToFile(0, sUrl, sFile, 0, 0)
   Cells(iRow, 1).Value = "X"
   Set pct = ActiveSheet.Pictures.Insert(sFile)
   Rows(iRow).RowHeight = pct.Height
   Call StartCounter
End Sub