Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 17:18:47
Große Datenmenge in komplexes Diagramm verpacken
26.04.2024 16:22:47
Aktualisierung Verknüpfung bei geschlossener Quelldatei
26.04.2024 16:05:28
PivotChart-Stapeldiagramm erstellen
26.04.2024 15:34:42
Überlagernde Textbox-Ansicht
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1072to1076
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1072to1076
1072to1076
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Pfadangabe in einem Anhang-Icon

Pfadangabe in einem Anhang-Icon
18.05.2009 09:55:02
Joachim
Hallo,
mit diesem Code will ich in mein Sheet Anhänge reinmachen, geht auch ganz gut. Frage: was muss ich ändern, dass unterhalb des Icons nicht der ganze Pfad angezeigt wird, sondern nur der reine Dateiname.
Dim Dateiname As Variant
Dim ooObjekt As OLEObject
Dateiname = Application.GetOpenFilename '("Micrsoft Excel-Dateien (*.xls),*.xls")
If Dateiname = False Then Exit Sub
Set ooObjekt = ActiveSheet.OLEObjects.Add(Filename:=Dateiname, Link:=False, _
DisplayAsIcon:=True, IconFileName:= _
"C:\WINDOWS\Installer\{90110409-6000-11D3-8CFE-0150048383C9}\xlicons.exe", _
IconIndex:=5, IconLabel:=Dateiname)
With ooObjekt
.Top = Range("C39").Top + 4
Danke
Joachim

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Pfadangabe in einem Anhang-Icon
18.05.2009 10:08:29
fcs
Hallo Joachim,
mit folgender Anweisung für den IconLabel-Text.

IconLabel:=Mid(Dateiname, Len(VBA.CurDir) + 2)


Gruß
Franz

AW: Pfadangabe in einem Anhang-Icon
18.05.2009 10:28:27
Joachim
Hallo Franz,
Danke, passt. Kannst Du mir vielleicht noch eine Frage beantworten (wenn wir schon dabei sind :-) )
Wenn ich eine Datei anhänge, verpasse ich ihm auch ein Icon: zB: IconIndex:=5
Damit hat aber jede angehängte Datei immer das gleiche Icon ( egal ob Word, Excel...)
Kann man beim Anhängen der Datei nicht das icon verwenden, das der Datei entpricht, also wenn ich ein Word anhänge, dann ein Word icon, bei einer Excel Datei ein Excel-Icon usw. ?
Geht das, oder muss man sich auf ein Icon festelegen ?
Danke
Joachim
Anzeige
AW: Pfadangabe in einem Anhang-Icon
18.05.2009 16:27:03
fcs
Hallo Joachim,
das geht theoretisch, wenn du für jeden Dateityp die zugehörige Icondatei kennst - einfach das Einbinden verschiedener Dateitypen mit dem Recorder aufzeichnen.
Dann kan man über die Dateierweiterung das zugehörige Icon steuern.
Gruß
Franz

Sub aatest()
Dim Dateiname As Variant
Dim ooObjekt As OLEObject
Dim strIconFN As String, lngIconIndex As Long, strExt As String
Dateiname = Application.GetOpenFilename '("Micrsoft Excel-Dateien (*.xls),*.xls")
If Dateiname = False Then Exit Sub
'dateierweiterung
strExt = LCase(Right(Dateiname, Len(Dateiname - InStrRev(Dateiname, "."))))
Select Case strExt
Case "xls", "xlsm"
strIconFN = _
"C:\WINDOWS\Installer\{90110409-6000-11D3-8CFE-0150048383C9}\xlicons.exe"
lngIconIndex = 5
Case "doc", "docm"
strIconFN = _
lngIconIndex = 1
Case "pdf"
strIconFN = _
lngIconIndex = 1
Case Else
strIconFN = _
lngIconIndex = 1
End Select
Set ooObjekt = ActiveSheet.OLEObjects.Add(Filename:=Dateiname, Link:=False, _
DisplayAsIcon:=True, IconFileName:=strIconFN, _
IconIndex:=lngIconIndex, IconLabel:=Dateiname)
With ooObjekt
.Top = Range("C39").Top + 4
End With
End Sub


Anzeige
Pfadangabe in einem Anhang-Icon
19.05.2009 12:17:28
Joachim
Hallo Franz,
Danke Dir. Habe nur noch etwas Startschwierigkeiten. Habe mal die Formate XLS, DOC und PDF mit dem Macrorecorder aufgezeicnet. Irgend wie bekomme ich aber noch Fehler. Kannst Du sehen, warum ? Danke
Dim Dateiname As Variant
Dim ooObjekt As OLEObject
Dim strIconFN As String, lngIconIndex As Long, strExt As String
Dateiname = Application.GetOpenFilename '("Micrsoft Excel-Dateien (*.xls),*.xls")
If Dateiname = False Then Exit Sub
'dateierweiterung
strExt = LCase(Right(Dateiname, Len(Dateiname - InStrRev(Dateiname, "."))))
Select Case strExt
Case "xls", "xlsm"
strIconFN = "C:\WINDOWS\Installer\{90110409-6000-11D3-8CFE-0150048383C9}\xlicons.exe"; _
lngIconIndex:=0, IconLabel:=Mid(Dateiname, Len(VBA.CurDir) + 2)
Case "doc", "docm"
strIconFN = "C:\WINDOWS\Installer\{90110409-6000-11D3-8CFE-0150048383C9}\wordicon.exe", _
lngIconIndex:=0, IconLabel:=Mid(Dateiname, Len(VBA.CurDir) + 2)
lngIconIndex = 1
Case "pdf"
strIconFN = "C:\WINDOWS\Installer\{AC76BA86-1033-F400-BA7E-000000000004}\_PDFFile.ico", _
IconIndex:=0, IconLabel:=Mid(Dateiname, Len(VBA.CurDir) + 2)
Case Else
strIconFN = "C:\WINDOWS\Installer\{90110409-6000-11D3-8CFE-0150048383C9}\xlicons.exe", _
lngIconIndex:=5, IconLabel:=Mid(Dateiname, Len(VBA.CurDir) + 2))
End Select
Set ooObjekt = ActiveSheet.OLEObjects.Add(Filename:=Dateiname, Link:=False, _
DisplayAsIcon:=True, IconFileName:=strIconFN, _
IconIndex:=lngIconIndex, IconLabel:=Dateiname)
With ooObjekt
.Top = Range("C39").Top + 4
End With
With ooObjekt
.Top = Range("C39").Top + 4
If ActiveSheet.OLEObjects.Count > 2 Then
.Left = ActiveSheet.OLEObjects(ActiveSheet.OLEObjects.Count - 1).Left + ActiveSheet. _
OLEObjects(ActiveSheet.OLEObjects.Count - 1).Width + 3
Else
.Left = Range("C39").Left + 4
End If
End With
Anzeige
keiner einer Idee ?
20.05.2009 11:52:26
Joachim
AW: Pfadangabe in einem Anhang-Icon
20.05.2009 11:57:58
fcs
Hallo Joachim,
da war noch etwas Unordnung bei der Zuweisung der Werte für den Dateinamen der Icon-Datei und der Icon-Index-Nummer.
Gruß
Franz

Dim Dateiname As Variant
Dim ooObjekt As OLEObject
Dim strIconFN As String, lngIconIndex As Long, strExt As String
Dateiname = Application.GetOpenFilename '("Micrsoft Excel-Dateien (*.xls),*.xls")
If Dateiname = False Then Exit Sub
'dateierweiterung
strExt = LCase(Right(Dateiname, Len(Dateiname - InStrRev(Dateiname, "."))))
Select Case strExt
Case "xls", "xlsm"
strIconFN = "C:\WINDOWS\Installer\{90110409-6000-11D3-8CFE-0150048383C9}\xlicons.exe"
lngIconIndex = 0
Case "doc", "docm"
strIconFN = "C:\WINDOWS\Installer\{90110409-6000-11D3-8CFE-0150048383C9}\wordicon.exe"
lngIconIndex = 0
Case "pdf"
strIconFN = "C:\WINDOWS\Installer\{AC76BA86-1033-F400-BA7E-000000000004}\_PDFFile.ico"
IconIndex = 0
Case Else
strIconFN = "C:\WINDOWS\Installer\{90110409-6000-11D3-8CFE-0150048383C9}\xlicons.exe"
lngIconIndex = 5
End Select
Set ooObjekt = ActiveSheet.OLEObjects.Add(Filename:=Dateiname, Link:=False, _
DisplayAsIcon:=True, IconFileName:=strIconFN, _
IconIndex:=lngIconIndex, IconLabel:=Mid(Dateiname, Len(VBA.CurDir) + 2))
With ooObjekt
.Top = Range("C39").Top + 4
If ActiveSheet.OLEObjects.Count > 2 Then
.Left = ActiveSheet.OLEObjects(ActiveSheet.OLEObjects.Count - 1).Left + ActiveSheet. _
OLEObjects(ActiveSheet.OLEObjects.Count - 1).Width + 3
Else
.Left = Range("C39").Left + 4
End If
End With


Anzeige
AW: Pfadangabe in einem Anhang-Icon
20.05.2009 13:13:57
Joachim
Hallo Franz,
toll dass Du dich nochmal gemeldet hast: also, zumindest läuft der Code nun durch, aber irgend wie scheint der Code die verschiedenen Dateieindungen (xls, doc, pdf) nicht zu erkennen, sondern nimmt sich bei jeder datei, egal welchen Typ ich anhängen will, das icon aus der Zeile
Case Else
strIconFN = "C:\WINDOWS\Installer\{90110409-6000-11D3-8CFE-0150048383C9}\xlicons.exe"
lngIconIndex = 5
Ist das bei Dir auch so ? Also egal, welchen Index ich da einstelle, er wird immer für alle Dateien genommen. Soll ich Dir mal eine Testdatei schicken, oder kannst Du das nachvollziehen ?
Danke Dir
Joachim
Anzeige
AW: Pfadangabe in einem Anhang-Icon
20.05.2009 14:38:16
fcs
Hallo Joachim,
ich hab es jetzt mal bei mir komplett mit den bei mir vorhandenen Icon-Dateien eingerichtet.
2 Korrekturen waren noch nötig.
Die Namen der Icon-Dateien und die Index-Nummern muss du natürlich wieder an dein System anpassen.
Gruß
Franz

Erstellt unter Excel 2003, Windows XP
Sub aaaTest()
Dim Dateiname As Variant
Dim ooObjekt As OLEObject
Dim strIconFN As String, lngIconIndex As Long, strExt As String
Dateiname = Application.GetOpenFilename '("Micrsoft Excel-Dateien (*.xls),*.xls")
If Dateiname = False Then Exit Sub
'dateierweiterung
strExt = LCase(Right(Dateiname, Len(Dateiname) - InStrRev(Dateiname, ".")))  '### Korrektur
Select Case strExt
Case "xls", "xlsm", "xlt"
strIconFN = "C:\WINDOWS\Installer\{90110407-6000-11D3-8CFE-0150048383C9}\xlicons.exe"
lngIconIndex = 4
Case "doc", "docm", "dot"
strIconFN = "C:\WINDOWS\Installer\{90110407-6000-11D3-8CFE-0150048383C9}\wordicon.exe"
lngIconIndex = 0                                              '### Korrektur
Case "pdf"
strIconFN = "C:\WINDOWS\Installer\{AC76BA86-7AD7-1031-7B44-A81000000003}\PDFFile_8.ico"
lngIconIndex = 0
Case Else
strIconFN = "packager.exe"
lngIconIndex = 0
End Select
Set ooObjekt = ActiveSheet.OLEObjects.Add(Filename:=Dateiname, Link:=False, _
DisplayAsIcon:=True, IconFileName:=strIconFN, _
IconIndex:=lngIconIndex, IconLabel:=Mid(Dateiname, Len(VBA.CurDir) + 2))
With ooObjekt
.Top = Range("C39").Top + 4
If ActiveSheet.OLEObjects.Count > 2 Then
.Left = ActiveSheet.OLEObjects(ActiveSheet.OLEObjects.Count - 1).Left + ActiveSheet. _
OLEObjects(ActiveSheet.OLEObjects.Count - 1).Width + 3
Else
.Left = Range("C39").Left + 4
End If
End With
End Sub


Anzeige
Jetzt gehts, nur noch ne kleine Nachfrage...
20.05.2009 19:04:58
Joachim
Hi Franz,
super , jetzt gehts. Vielen, vielen Dank.
Nur noch eine Frage, wenn ich das Sheet mit diesem Makro nun an einen anderen Arbeitsplatz weiter gebe, muss ich dann damit rechnen, dass wieder kein Icon zugewiesen werden kann, weil bei dem Rechner vielleicht der Pfad zum Icon wieder anders heist ?
Ich konnte bei Deinem Beispiel ja mit Deinem Pfad auch nichts anfangen, sondern musste meinen eigenen Pfad einbauen ! Gilt dieser Pfad nur lokal ?
Ist das so ?
Gruss
Joachim

Links zu Excel-Dialogen

Label

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige