Hyperlink verwenden

Bei umfangreichen Projekten empfiehlt es sich, eine Infobox mit einer kurzen Beschreibung des Projektes/Programmes und dem Namen des Entwicklers einzubinden. Wer in dieser Infobox auch einen Hyperlink auf eine bestimme Web-Seite setzen möchte, kann dies mit einem Bezeichnungsfeld und dem API  ShellExecute erreichen.

Das Bezeichnungsfeld wird zum besseren Erkennen wie ein Standard-Hyperlink formatiert; gleichzeitig wird eine Eigenschaft der Controls verwendet, die es erlaubt, eigene Mauszeiger zu verwenden.

Das folgende Beispiel demonstriert die Verwendung eines Bezeichnungsfeldes als Hyperlink (Infolink). Um das Beispiel auszuführen, genügt es den nachstehenden Code in eine leere Userform zu kopieren.
In der Prozedur  UserForm_Initialize() werden die Größe der Userform gesetzt und gleichzeitig das Bezeichnungsfeld und eine Schaltfläche eingefügt und formatiert.

In der Prozedur  lblInfolink_Click() wird dann das mit einem Hyperlink verknüpfte Programm (normalerweise der Browser) gestartet und die angegebene Seite aufgerufen.
Mit wenig Aufwand lässt sich der Infolink auch durch einen Mailaufruf ersetzen. Dazu muss sowohl die Beschriftung des Feldes als auch der Aufruf geändert werden. Im Aufruf muss der Zusatz "mailto:" eingefügt werden, damit das Standard-Mailprogramm gestartet wird.

Private bHyperlink As Boolean 
Private Declare Function ShellExecute Lib "Shell32.dll" _
  Alias "ShellExecuteA" (ByVal hWnd As Long, _
  ByVal lpOperation As String, _
  ByVal ProgName As String, _
  ByVal Parameter As String, _
  ByVal Verzeichnis As String, _
  ByVal Modus As Long) _
As Long 
Private WithEvents lblInfolink As MSForms.Label
Private WithEvents lblEnde As MSForms.CommandButton
Const strCaption = "Hyperlink auf ein Bezeichnungsfeld"
' Der Pfad zum verwendeten Icon oder Cursor
Const IconPfad = "C:\WINNT\Cursors\harrow.cur"

Private Sub UserForm_Initialize()  
' Userform anpassen  
With Me 
  .Width = 240
  .Height = 120
  .Top = 300
  .Caption = strCaption
End With 
' Label-Control hinzufügen  
Set lblInfolink = Controls.Add("Forms.Label.1", "lblInfolink", True)
' Label-Control formatieren  
With lblInfolink
' Muss entweder mit "www" anfangen oder mit "http://",  
' damit der Aufruf klappt  
  .Caption = "www.chf-online.de"
  .Font.Size = 13
  .Font.Bold = True 
  .Font.Underline = True 
  .WordWrap = False 
  .Width = Len(.Caption) * PointsToPixels(.Font.Size / 2, True)
  .Height = .Font.Size + 2
  .Top = frmInfoLink.Height / 2 - .Font.Size
  .Left = (frmInfoLink.Width - .Width) / 2
  .ForeColor = RGB(0, 0, 255)
End With 
' Schaltfläche zum Beenden einfügen  
Set lblEnde = Controls.Add("Forms.Commandbutton.1", "lblEnde", True)
' Schaltfläche "Ausblenden" formatieren  
With lblEnde
  .Caption = "Ausblenden"
  .Font.Size = 8
  .Width = 72
  .Height = 24
  .Top = lblInfolink.Top + lblInfolink.Height + 10
  .Left = (frmInfoLink.Width - .Width) / 2
End With 
End Sub 

Private Sub lblInfolink_Click()  
Dim RetVal As Long 
If bHyperlink = True Then 
  RetVal = ShellExecute(&O0, vbNullString, lblInfolink.Caption, _
    vbNullString, vbNullString, vbNormalFocus)
End If 
End Sub 

Private Sub lblInfolink_MouseMove(ByVal Button As Integer, _
  ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim sYDiff As Single
sYDiff = ((lblInfolink.Height - lblInfolink.Font.Size) / 2)
If (Y > sYDiff) And (Y < lblInfolink.Height - sYDiff) Then 
  bHyperlink = True 
  lblInfolink.MousePointer = fmMousePointerCustom
  lblInfolink.MouseIcon = LoadPicture(IconPfad)
Else 
  bHyperlink = False 
  lblInfolink.MousePointer = fmMousePointerDefault
End If 
End Sub 

Private Sub lblEnde_Click()  
Unload Me 
End Sub  

Bei der Größenanpassung des Bezeichnungsfeldes wird versucht, eine optimale Positionierung in der Mitte der Userform zu erreichen. Leider stehen in VBA nicht viele Möglichkeit der Pixel-Umrechung zur Verfügung, so dass an diesen Stellen auch gut feste Angaben eingetragen werden können.