Actualisation gadgethtml vba

boulou14

XLDnaute Nouveau
Bonjour,
j'ai une application dans laquelle j'ai créé un écran MENU, sur ce userform, j'ai placé un webbrowser pour faire défiler un message contenant la date et l'heure. Tout fonctionne bien ;) sauf que l'heure ne s'actualise pas :mad: !!! Avez-vous une idée ???

ci-dessous la partie de code qui me commande mon gadget:

Private Sub UserForm_Initialize()

GadgetHtml "Bonjour et bienvenue dans S.A.P.I.N, " & "nous sommes le " & Day(Now) & "/" & Month(Now) & "/" & Year(Now) & ", il est " & Hour(Now) & ":" & Minute(Now), "#000069"

End Sub


Private Sub GadgetHtml(Texto As String, Couleur As String)
Me.WebBrowser1.Navigate _
"about:<html><body BGCOLOR ='#CCCCCC' scroll='no'><font color= " _
& Couleur & " size='5' face='comic sans ms'>" & _
"<marquee scrollAmount=8>" & Texto & "</marquee></font></body></html>"

End Sub



Merci d'avance.
 

fhoest

XLDnaute Accro
Re : Actualisation gadgethtml vba

Bonjour,
je te propose d'utiliser cette méthode à défaut de corriger ton problème avec le webbrowser.
pour ton souci je pense que tu doit insérer un script javascript dans ton code html,puis mettre à jour tes variables à lintérieure de ce dernier.
Voici une solution avec VBA. + petite triche visuelle pour l'effet que tu souhaites avoir.
A bientôt.
 

Pièces jointes

  • wait.xlsm
    23.4 KB · Affichages: 43

JCGL

XLDnaute Barbatruc
Re : Actualisation gadgethtml vba

Bonjour à tous,
Salut Fred,

Dans le module de l'USF :

VB:
Dim Txt As String
Dim i As Integer, Ln As Integer
Dim Fin As Boolean
Dim Pos As Integer


Private Sub CommandButton1_Click()
    Pos = TextBox1.Left: Ln = 1
    While Fin = False
        TextBox1.Left = Pos
        For i = 1 To Ln
            Txt = "Bonjour et bienvenue dans S.A.P.I.N, " & _
            "nous sommes le " & Format(Date, "dddd dd mmmm yyyy") & _
            ", il est " & Format(Now, "hh:mm:ss") & Space(20)
            Ln = Len(Txt)
            TextBox1.Text = Left(Txt, i): TextBox1.Left = TextBox1.Left - 4
            Me.Repaint
            TimerMS
        Next
    Wend
End Sub


Private Sub CommandButton2_Click()
    Fin = True
    Unload UserForm1
End Sub

Dans un module standard :

VB:
' d'après [url=http://www.developpez.net/forums/d854973/logiciels/microsoft-office/excel/macros-vba-excel/application-wait-vba/][XL-2003] Application WAIT en VBA [Résolu][/url]
Declare Function GetTickCount Lib "kernel32" () As Long


Sub TimerMS()
    Dim TP As Long
    TP = GetTickCount
    Do While TP + 205 > GetTickCount
        DoEvents
    Loop
End Sub


Sub Voir()
    UserForm1.Show
End Sub

A+ à tous
 

Pièces jointes

  • JC Wait.xlsm
    25.2 KB · Affichages: 37
Dernière édition: