Insertion d'un lien hypertexte dans Userform VBA

Question

J'ai créé une note de bienvenue dans Excel en utilisant userform, qui est affichée à chaque fois pendant 6 secondes chaque fois que j'ouvre le classeur. J'ai inséré un lien hypertexte sur ce userform. Mais ce lien hypertexte ne fonctionne pas. j'avais utilisé le code suivant dans cette étiquette ..

Private Sub Label2_Click() 

    Link = "https://www.healthindiatpa.com/" 

    On Error GoTo NoCanDo 

    ActiveWorkbook.FollowHyperlink Address:=Link, NewWindow:=True 

    Unload Me 

    Exit Sub 

NoCanDo: 

    MsgBox "Cannot open " & Link 

End Sub 

Mais il ne fonctionne pas. Chaque fois que je clique sur cette étiquette ou un lien hypertexte lorsque le classeur s'ouvre, le site ne s'ouvre pas. Le lien hypertexte ne fonctionne pas. Userform image

Answer 1

Le problème se produit dans cet extrait:

Private Sub UserForm_Activate() 
Application.Wait (Now + TimeValue("00:00:01")) 
UserForm1.Label1.Caption = "Loading Data..." 
UserForm1.Repaint 
Application.Wait (Now + TimeValue("00:00:03")) 
UserForm1.Label1.Caption = "Please make sure Database file is open..." 
UserForm1.Repaint 
Application.Wait (Now + TimeValue("00:00:02")) 
UserForm1.Label1.Caption = "Opening..." 
UserForm1.Repaint 
Application.Wait (Now + TimeValue("00:00:01")) 
Unload UserForm1 
End Sub 

L'application est juste en attente (afin de ne pas accepter l'entrée que ce soit). C'est pourquoi votre événement ne se déclenche pas, car après l'attente, il continue immédiatement avec la ligne suivante (qui est le changement d'étiquette et repeindre).

Vous pouvez le corriger en modifiant cette routine comme suit:

Private Sub UserForm_Activate() 
Application.Wait (Now + TimeValue("00:00:01")) 
DoEvents 'Allow for the label click to trigger!!! 
UserForm1.Label1.Caption = "Loading Data..." 
UserForm1.Repaint 
Application.Wait (Now + TimeValue("00:00:03")) 
DoEvents 'Allow for the label click to trigger!!! 
UserForm1.Label1.Caption = "Please make sure Database file is open..." 
UserForm1.Repaint 
Application.Wait (Now + TimeValue("00:00:02")) 
DoEvents 'Allow for the label click to trigger!!! 
UserForm1.Label1.Caption = "Opening..." 
UserForm1.Repaint 
Application.Wait (Now + TimeValue("00:00:01")) 
DoEvents 'Allow for the label click to trigger!!! 
Unload UserForm1 
End Sub 

Ce n'est pas très propre, mais cette façon, vous serez invité à entrer le code de l'événement et résoudre votre problème sans d'autres modifications.

Éditer: Cette réponse vous indique comment capturer l'événement et le faire fonctionner, ce qui était la question. Problèmes avec le FollowHyperlink est une deuxième chose: MSDN dit que la méthode va "ouvrir le programme approprié" en fonction de la cible que vous passez.

Étant donné que le code est correct et l'événement se déclenche, cela est très probablement un tout autre problème qui n'a rien à voir avec la VBA/votre question.

Sur ma machine (W7 + Excel 2016) le code s'exécute parfaitement et le clic sur le lien fonctionne, de manière cohérente.