hoe iedere minuut code uitvoeren

[Jomjan]

zie onderstaande code.

de sheet haalt, na het klikken van de button gegevens uit een extern programma. Dat werkt prima, alleen wil ik dat hij dit automatisch doet na bv iedere 60 seconden, zonder dat ik iedere keer op de knop hoef te klikken. graag jullie hulp. alvast bedankt

Dim BlpControl As BBData

Private Sub CommandButton1_Click()
    Dim nRow As Integer
    Dim nColumn As Integer
    Dim vtSecurities As Variant
    Dim vtFields As Variant
    Dim dtStart As Date
    Dim dtEnd As Date
    
    vtSecurities = WorksheetFunction.Transpose(Range(Cells(5, 1), Cells(16, 1)))
    vtFields = Array("LAST PRICE")
    
    nColumn = 6
    'Clear the old data
    For nRow = 1 To 12
      Worksheets(1).Range(Cells(6, nColumn), Cells(Cells(6, nColumn + 3).End(xlDown).Row, nColumn + 3)).ClearContents
      nColumn = nColumn + 4
    Next
    
    'set the start/end dates
    dtStart = CDate(CDate(Range("C6").Text) & " " & TimeSerial(Hour(Time), Minute(Time) - 3, Second(Time)))
    dtEnd = CDate(CDate(Range("D6").Text) & " " & TimeSerial(Hour(Time), Minute(Time) - 2, Second(Time)))

    If BlpControl Is Nothing Then Set BlpControl = New BBData
    BlpControl.MakeHistoryRequest vtSecurities, vtFields, dtStart, dtEnd
    
End Sub

en de code van de module:

Dim WithEvents BbgTick As BLP_DATA_CTRLLib.BlpData
Dim nRow As Integer
Dim nColumn As Integer

Private Sub Class_Initialize()
    'Create new instance of control
    Set BbgTick = New BlpData
End Sub
Private Sub BbgTick_Data(Security As Variant, cookie As Long, Fields As Variant, Data As Variant, Status As Long)

Dim nRows As Long
Dim nRowCnt As Long
 
If UBound(Data, 1) > 65529 Then
   MsgBox "Data too large and hence cannot be displayed", vbInformation
   Exit Sub
End If
Worksheets(1).Range(Cells(nRow, cookie), Cells(5 + UBound(Data, 1), cookie + 2)) = Data

End Sub

Private Sub Class_Terminate()
    Set BbgTick = Nothing
End Sub

Public Sub MakeHistoryRequest(vtSecList As Variant, vtFields As Variant, dtStartDate As Date, dtEndDate As Date)
    Dim nSecCnt As Long
    Dim nCookie As Integer
    
    'Set subscriptionmode
    BbgTick.SubscriptionMode = BySecurity
    'Hold the request in the control
    BbgTick.AutoRelease = False
    
    nCookie = 6
    'Request Bloomberg Historical Data
    For nSecCnt = LBound(vtSecList, 1) To UBound(vtSecList, 1)
            BbgTick.GetHistoricalData2 vtSecList(nSecCnt), nCookie, vtFields, dtStartDate, "USD", dtEndDate, 0
            nCookie = nCookie + 4
    Next nSecCnt
    'Flush out the request
    BbgTick.Flush
    nRow = 6
    nColumn = 6
End Sub

 

[AlexV]

Hoi,

Je zou een loop kunnen inbouw met een wait.

Zoals:

Do
Application.Wait (Now + TimeValue("0:01:00"))
  'Je Code
Loop

Deze stop niet "loop Until" zou ik gebruiken.

Of je gebruik de OnTime die je aan het einde inbouwt.

Application.OnTime Now + TimeValue("00:01:00"), "MyMacro"

Deze is beter daar de code niet blijft lopen.

Gr,
Alex,

 

[Jomjan]

alex,

- zou je in mijn code aan kunnen geven waar exact ik de loopcode moet invoeren
- voor de 2e optie: wat is in mijn geval de naam van "mymacro"

heb van alles geprobeerd, maar nog geen success.

 

[AlexV]

Je zou die dan een kunnen maken als:

Dim BlpControl As BBData

Private Sub CommandButton1_Click()
    Call MyMacro1
End Sub

Sub MyMacro1()
    Dim nRow As Integer
    Dim nColumn As Integer
    Dim vtSecurities As Variant
    Dim vtFields As Variant
    Dim dtStart As Date
    Dim dtEnd As Date
    
    vtSecurities = WorksheetFunction.Transpose(Range(Cells(5, 1), Cells(16, 1)))
    vtFields = Array("LAST PRICE")
    
    nColumn = 6
    'Clear the old data
    For nRow = 1 To 12
      Worksheets(1).Range(Cells(6, nColumn), Cells(Cells(6, nColumn + 3).End(xlDown).Row, nColumn + 3)).ClearContents
      nColumn = nColumn + 4
    Next
    
    'set the start/end dates
    dtStart = CDate(CDate(Range("C6").Text) & " " & TimeSerial(Hour(Time), Minute(Time) - 3, Second(Time)))
    dtEnd = CDate(CDate(Range("D6").Text) & " " & TimeSerial(Hour(Time), Minute(Time) - 2, Second(Time)))

    If BlpControl Is Nothing Then Set BlpControl = New BBData
    BlpControl.MakeHistoryRequest vtSecurities, vtFields, dtStart, dtEnd
    
    Application.OnTime Now + TimeValue("00:01:00"), "MyMacro1"

end sub

Dit zelfde voor je andere code.

Gr,
Alex,