Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Verknüpfung mit Symbol-Bild erstellen | Herbers Excel-Forum


Betrifft: Verknüpfung mit Symbol-Bild erstellen von: Dietmar aus Aachen
Geschrieben am: 26.01.2010 20:26:55

Hallo zusammen!

Folgenden Code habe ich hier im Forum erhalten ... und ... er funktioniert klasse!

Ist es möglich diesen Code so zu erweitern, dass die Verknüpfung direkt mit einem Symbol dargestellt wird?

Beispielsweise mit dem Schmetterling, den man als OrdnerSymbol verwenden kann:
%SystemRoot%\system32\SHELL32.dll
Händisch lässt sich dies bei Verknüpfungen ja nachholen (Rechtsklick auf die Verknüpfung >Eigenschaften >anderesSymbol).
Somit vermute ich, dass das auch direkt codiert werden kann.
Jemand eine Ahnung wie der nachfolgende Code angepasst werden müsste?

Vielen Dank vorab!

Dietmar aus Aachen

Hier der Code:

Sub DesktopVerknüpfungErstellen()

    Dim strDesktop As String
    Dim objLink As Object
    Dim strFile As String
    Dim strPath As String
    Dim objWSH As Object
    
    On Error GoTo Fin
    
    strPath = "C:\OrdnerXY\" ' anpassen
    strFile = "DateiXY" ' anpassen
    
    If Dir$(strPath & strFile) = "" Then Error 53
    
    Set objWSH = CreateObject("WScript.Shell")
    strDesktop = objWSH.SpecialFolders("Desktop")
    Set objLink = objWSH.CreateShortcut(strDesktop & "\" & strFile & ".lnk")
    With objLink
        .Targetpath = strPath & strFile
        .Save
    End With
    
MsgBox "Fertig!", vbInformation, "Meldung"

cleanup:
Set objWSH = Nothing
Exit Sub

Fin:
    
    MsgBox "Die Verknüpfung konnte NICHT erstellt werden; Datei nicht vorhanden.", vbCritical, " _
Hinweis"
                
Resume cleanup
    
End Sub

  

Betrifft: AW: Verknüpfung mit Symbol-Bild erstellen von: Tino
Geschrieben am: 26.01.2010 21:58:16

Hallo,
könnte so gehen.

Mit der Nummer hinten bei .IconLocation ... kannst Du das Symbol einstellen.

Sub Beispiel()
Dim oShell As Object, oLink As Object
Dim strDesktop$, strPath$, strFile$, strLinkName$

strPath = "C:\OrdnerXY\" 'Ordner anpassen
strFile = "timer 2.xls"  'Dateiname anpassen
strLinkName = "xxxx.lnk" 'wie soll der link heißen?

If Dir(strPath & strFile) <> "" Then
    ' Verweis auf den Windows Scripting Host erstellen
    Set oShell = CreateObject("WScript.Shell")
    
    'Desktoppfad?
    strDesktop = oShell.SpecialFolders("Desktop")
    strDesktop = IIf(Right$(strDesktop, 1) = "\", strDesktop, strDesktop & "\")
    
    ' Neuen Link Erstellen auf strDesktop
    Set oLink = oShell.CreateShortcut(strDesktop & strLinkName)
    
    With oLink
        .TargetPath = strPath & strFile 'Pfad zur Datei
        .IconLocation = "%SystemRoot%\system32\SHELL32.dll, 4" 'Symbol
        .Save 'speichern
    End With
End If

Set oLink = Nothing
Set oShell = Nothing
End Sub
Gruß Tino


  

Betrifft: Tino KLASSE! habe was ergänzt, o.k. so? von: Dietmar aus Aachen
Geschrieben am: 27.01.2010 15:52:50

Hallo Tino,

hammerstark! Danke.

Habe noch Errormeldung und Erfolgsmeldung reingebastelt. Funktioniert auch.
Schau doch mal bitte drüber, ob ich etwas gravierendes falsch gemacht habe, oder ob es so gut ist.

Herzlichen Dank!

Viele Grüße
Dietmar aus Aachen

Sub BeispielVonDietmarErgaenzt()

Dim oShell As Object, oLink As Object
Dim strDesktop$, strPath$, strFile$, strLinkName$

On Error GoTo Fin   'von Dietmar ergänzt

    strPath = "C:\OrdnerXY\" 'Ordner anpassen
    strFile = "timer 2.xls"  'Dateiname anpassen
    strLinkName = "NameLink.lnk" 'wie soll der link heißen?

If Dir(strPath & strFile) = "" Then Error 53    'On Error-Meldung von Dietmar ergänzt
    ' Verweis auf den Windows Scripting Host erstellen
    Set oShell = CreateObject("WScript.Shell")
    
    'Desktoppfad?
    strDesktop = oShell.SpecialFolders("Desktop")
    strDesktop = IIf(Right$(strDesktop, 1) = "\", strDesktop, strDesktop & "\")
    
    'Neuen Link Erstellen auf strDesktop
    Set oLink = oShell.CreateShortcut(strDesktop & strLinkName)
    
    With oLink
        .TargetPath = strPath & strFile 'Pfad zur Datei
        .IconLocation = "%SystemRoot%\system32\SHELL32.dll, 43" 'Symbol Schmetterling = 130,  _
Stern = 43
        .Save 'speichern
    End With
        
MsgBox "Ja! das hat geklappt!", vbInformation, "Erfolgsmeldung"
        
    'End If     'von Dietmar auskommentiert
    
    
cleanup: 'von Dietmar ergänzt

Set oLink = Nothing
Set oShell = Nothing
    
Exit Sub:   'von Dietmar ergänzt
    
Fin:    'von Dietmar ergänzt

MsgBox "Nein! hat leider nicht geklappt, die Datei ist nicht vorhanden.", vbCritical, " _
Negativmeldung"  'von Dietmar ergänzt
  
End Sub



  

Betrifft: AW: Tino KLASSE! habe was ergänzt, o.k. so? von: Tino
Geschrieben am: 27.01.2010 16:55:27

Hallo,
schaut eigentlich gut aus, bis auf die Fehlerbehandlung.

Die würde ich eventuell so machen.

Sub BeispielVonDietmarErgaenzt()

Dim oShell As Object, oLink As Object
Dim strDesktop$, strPath$, strFile$, strLinkName$

On Error GoTo ErrorHandler:  'von Dietmar ergänzt 

    strPath = "C:\OrdnerXY\" 'Ordner anpassen 
    strFile = "timer 2.xls"  'Dateiname anpassen 
    strLinkName = "NameLink.lnk" 'wie soll der link heißen? 

If Dir(strPath & strFile) = "" Then GoTo Fin: 'On Error-Meldung von Dietmar ergänzt 
    
    ' Verweis auf den Windows Scripting Host erstellen 
    Set oShell = CreateObject("WScript.Shell")
    
    'Desktoppfad? 
    strDesktop = oShell.SpecialFolders("Desktop")
    strDesktop = IIf(Right$(strDesktop, 1) = "\", strDesktop, strDesktop & "\")
    
    'Neuen Link Erstellen auf strDesktop 
    Set oLink = oShell.CreateShortcut(strDesktop & strLinkName)
    
    With oLink
        .TargetPath = strPath & strFile 'Pfad zur Datei 
        .IconLocation = "%SystemRoot%\system32\SHELL32.dll, 43" 'Symbol Schmetterling = 130, Stern = 43 
        .Save 'speichern 
    End With
        
    MsgBox "Ja! das hat geklappt!", vbInformation, "Erfolgsmeldung"

Cleanup: 'von Dietmar ergänzt 

Set oLink = Nothing
Set oShell = Nothing
    
Exit Sub   'von Dietmar ergänzt 
    
Fin:    'von Dietmar ergänzt 
MsgBox "Nein! hat leider nicht geklappt, die Datei ist nicht vorhanden.", vbCritical, "Negativmeldung"  'von Dietmar ergänzt 
GoTo Cleanup:

ErrorHandler:
MsgBox "FehlerNummer: " & Err.Number & vbCr & vbCr & Err.Description, vbCritical, "Hat leider nicht geklappt!"
GoTo Cleanup:
End Sub
Gruß Tino


  

Betrifft: Das mit dem Error-Handler ist wirklich gut! von: Dietmar aus Aachen
Geschrieben am: 27.01.2010 17:46:20

Danke Tino,

das ist perfekt! Dass mal eine Symbolnummer nicht vorhanden sein könnte, hatte ich nicht bedacht. Ich hatte vermutet, dass eine Nr. 43 immer vorhanden ist; sollte der Stern mal bei einem Betriebssystem entfertn worden sein, dann dachte ich , dass automatisch ein anderes Symbole auf die Nr. 43 nachrückt. Ist aber wohl nicht so.

Kann ich eigentlich grundsätzlich davon aus gehen, dass die Symbolnummern bei allen Windows-Betriebssystemen identisch sind?

Viele Grüße
Dietmar aus Aachen


  

Betrifft: ich kann Dir auch nicht sagen... von: Tino
Geschrieben am: 27.01.2010 17:51:10

Hallo,
ob die auf allen Systemen gleich sind.

Gruß Tino


  

Betrifft: ... ok, sei's drum die Sache ist Spitze! von: Dietmar aus Aachen
Geschrieben am: 27.01.2010 18:16:57

Hallo Tino,

vielen Dank, du hast mir sehr geholfen.

Dietmar aus Aachen


Beiträge aus den Excel-Beispielen zum Thema "Verknüpfung mit Symbol-Bild erstellen"