Dateien als Icons in sheet -?? OLEObjects.Add

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub OrdnerEinlesen() Dim Dateiname As Variant On Error Resume Next ' Pfad = "C:\Test" Pfad = "C:\Eigene Dateien\Eigene Bilder" Dateifilter = "*.gif" 'oder auch z.B. "Bild*.jpg" oder "*.*" Dateiname = Dir(Pfad & "\" & Dateifilter) i = 2 ' 1. Tabellenzeile in die Objektbildchen eingefügt werden soll Schritt = 6 ' Zeilen-Abstand der Objektbildchen Spalte = 1 Do While Dateiname <> "" ActiveSheet.Cells(i, Spalte).Select ActiveSheet.OLEObjects.Add(FileName:=Dateiname, Link:=False, DisplayAsIcon:=False).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Height = 70 'Größe festlegen, entspricht ungefähr 6 Zeilenhöhen Dateiname = Dir i = i + Schritt If i Mod 38 = 0 Then Spalte = Spalte + 2: i = 2 ' ergibt Raster für Bilder auf dem Sheet Loop End Sub </pre<

Hallo Horst,
bei mir funktioniert es auf zwei Rechnern (Win98/RXCEL97, WinXP/Excel2003). Das Makro bettet die Dateien in die Excel-Datei ein. Bei mehrseitigen Dokumenten wird meist nur die 1. Seite angezeigt. Das angezeigte Bild stellt die Datei dar, funktioniert aber nur bei den Dateien, die als OLE-fähige-Objekte auf dem PC registriert sind, das ist die Liste, du du angezeigt bekommst, wenn du Menü Einfügen-Objekt wählst. Bei anderen Dateien wird ein ähnliches Symbol angezeigt, wie im Explorer.
Die Größe der Bildchen wird auf eine feste Höhe geändert, damit sich die Bildchen nicht bzw. nur horizontal überlappen.
Die Einstellung für DisplayAsIcon auf True zu ändern bringt nur etwas, wenn man zusätzlich angibt, wo Ecxcel das Icon findet(Pfad\Datei etc.). Probier mal mit dem Recorder, was da für ein Informationswust erforderlich wird.
Step ist ein spezielles Kommando, das in der Anweisung
For I = X to Y Step Z
Dabei legt dann Z fest mit welcher Schrittweite I in jeder Schleife geändert werden soll.
Ich hab die Variable Schritt verwendet, um festzulegen in welcher Tabellen-Zeile das nächste Bildchen eingefügt werden soll.
Mir ist immer noch nicht ganz klar was du mit diesem Makro am Ende ereichen willst. Letztendlich produzierst du je nach Anzahl der Dateien "nur" eine mehr oder weniger große Datei, deren Informationen du je nach Informationsgehalt der Dateien nur nach Doppelklick auf die Bildchen erkenne kannst.
Als eine Art kleiner Dateimanager ist dies sicher nicht der optimale Weg.
gruss Franz

Hallo Franz,
danke für deine Infos! Habe die Schritte aufgezeichnet, Aufzeichnugsteile in dein script implementiert, laufen lassen, Zeichen für Zeichen verglichen - weiß nicht warum, läuft jetzt jedenfalls auch bei mir ;-)) (zurückgewandelt zu deinem mit geringen Anpassungen)
Ich habe jedoch trotzt Hilfelesen noch eine Frage zu deinem VBA:
If i Mod 38 = 0 Then Spalte = Spalte + 6: i = 2 ' ergibt Raster für Bilder auf dem Sheet
'If i durch (Mod-Operator) 38 = leer (oder verbraucht) dann nächste Spalte (=jetzige Spalte + 6 und i-Startpunkt Zeile 2)
'Mehrfachmarkierung in einer Schleifenbearbeitung
'Der Modulo-Operator (oder Rest-Operator) dividiert Operand1 durch Operand2,
'rundet dabei Fließkommawerte zu ganzen Zahlen und gibt nur den Rest als Ergebnis zurück.
Trifft dies so zu und wenn ja oder nein - warum/wie?
Bitte erkläre mir doch die Zeile (was durch was z. B.)
Ich habe verschiedentlich die Angaben verändert, um zu sehen, welche Auswirkung dies jedesmal hat. Aber leider habe ich es nicht hinbekommen, die Spaltenfüllung der 1. Spalte bewusst zu beeinflussen. Ausserdem klappte es auch nicht, alle shapes im sheet auf einem Male zu deleten.
Das Ziel dieser Aktion besteht aus versch. Gründen: Für mehrere Filialen schreiben wir ein einheitliches Programm, wobei die Eingabebereiche die einzigen ungeschützten Bereiche sind, allerdings mit Gültigkeiten , Formaten etc. Leider kopieren einige Leutchen bestehende Werte in neue Bereiche (Strg + ... z. B. funktionieren ja meist und auch durch eigene Menüs und abgeschaltete Kontexe ersetzt durch eigene). Bei falsch kopierten Zellen z. B. sind dann u. a. diese Fehler Bremsen /Rausschmiss für Prozeduren wie Auswertungen, Pivots etc. Nun bin ich dabei, jede Stationsmappe (12 ident. Sheets) in Txt-Dateien zu exportieren (Inhalte, Farben, Format Farben und Format Fett), diese werden dann von 8 Filialen wieder zu Mappen aufgebaut und können soweit fast fehlerfrei weiter verarbeitet werden. Per Prozeduren gezippte Originaldateien via Emailversand waren auch nicht der wahre Jakob. Da jede Woche neue Daten hinzukommen und jede Woche sämtliche Auswertungen(auch Grafiken) neu erstellt werden, und weiter jede Datei aus jeder Woche archiviert werden soll, bietet es sich an, die z. B. 9 KB-großen txt-Dateien in ein sheet einzulagern. So sind a) Transfergrößen minimal, Fehlerquoten verringert, Archivierung gewährleistet und (durch kompletten Schutz des sheets mit den Dateien inkl. zipp) Eingriffe seitens der Mitarbeiter in den Filialen fast ausgeschlossen (man glaubt gar nicht, auf was für Ideen die alle kommen!). Weiter können so auch zusätzliche Dateien mit eingebunden werden für andere Abteilungen (deshalb dateiextensionsunabhängig). Hier kann sich dann jeder das heraussuchen, was er braucht. Und noch einige andere Gründe. Etwas lang geworden - aber bei der zu honorierenden Hilfe, die u. a. ich hier im Forum erfahre sollte es schon gestattet sein, auch einmal eine längere Beantwortung für den Gebenden schreiben zu dürfen. Als Anfänger bin ich für jeden Finger dankbar!! Soweit. Gruß aus Bremen, Horst

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

Beliebteste Forumthreads (12 Monate)

Dateien als Icons in sheet -?? OLEObjects.Add

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread