AW: Dateien als Icons in sheet -? OLEObjects.Add
28.07.2006 01:36:05
fcs
Hallo Horst,
ich glaube ich hab das Teufelchen gefunden. In der Routine wurde für das Öffnen der Objekt-Dateien bisher nur der Dateiname (erzeugt mit der Dir-Anweisung) ohne Pfad verwendet. So hat das Makro wahrscheinlich nur korrekt gearbeitet, wenn zufällig der aktuelle Pfad in Excel = dem Pfad "C:\Test" war. Ich hab die Routine jetzt so angepaßt, dass der Pfad für das einzubindende Objekt als Parameter mit übergeben wird.
Sub TestOrdnerEinlesen1()
Dim Dateiname As Variant, Schritt As Integer, Pfad As String, Dateifilter As String
Dim iconsprospalte As Integer, iconzeile As Integer, Schrittspalte As Integer
On Error Resume Next
Pfad = "C:\Test"
Dateifilter = "*.txt" 'oder auch z.B. "Bild*.jpg" oder "*.*"
Dateiname = Dir(Pfad & "\" & Dateifilter)
ZeileStart = 2 ' 1. Tabellenzeile in die Objektbildchen eingefügt werden soll
iconsprospalte = 6 'Anzahl der Objektbildchen pro Spalte
Schritt = 6 ' Zeilen-Abstand der Objektbildchen
Schrittspalte = 6 ' Spalten-Abstand der Objektbildchen
iconzeile = 1 ' laufender Zähler für Icon-Zeilen
Spalte = 1
Do While Dateiname ""
ActiveSheet.Cells(ZeileStart + (iconzeile - 1) * Schritt, Spalte).Select
ActiveSheet.OLEObjects.Add(Filename:=Pfad & "\" & Dateiname, Link:=False, DisplayAsIcon:=False).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 80 'Größe festlegen, entspricht ungefähr 6 Zeilenhöhen
Dateiname = Dir
iconzeile = iconzeile + 1
If iconzeile > iconsprospalte Then
Spalte = Spalte + Schrittspalte
iconzeile = 1
End If
Loop
End Sub
Erläuterung:
" If i Mod 38 = 0 Then Spalte = Spalte + 6: i = 2 ' ergibt Raster für Bilder auf dem Sheet"
Ist evtl. eine etwas unglückliche Wahl um die Anzahl Shapes je Spalte zu bestimmen.
Anzahl = (38- 2)/Schritt wobei 2 die 1. Zeile ist in der ein Icon ist
Um die Anzahl der Icons pro Spalte festzulegen muß die Zahl auf ein Vielfaches von Schritt (also 6) +2 geändert werden. Also 8, 14, 20, 26, 32, 38, 44 usw.
Ich hab das jetzt etwas verständlicher gelöst.
Löschen Shapes:
Manuell muss man leider bei gedrckter Shift-Taste alle Shapes einzeln anklicken und dann löschen.
Um alle Sheets im aktiven blatt zu löschen hab ich ein kleines Makro erstellt:
Sub AlleShapesLoeschen()
ActiveSheet.Shapes.SelectAll
Selection.Delete
End Sub
Gruß
Franz