Makro - Bilder ausführen | HERBERS Excel Forum

Forumthread: Makro - Bilder ausführen

Makro - Bilder ausführen

07.05.2024 10:21:13

SaschaL

Hallo Zusammen,

vielen Dank für die fleißigen Helfer, die hier immer sofort unterstützen.

Folgende Fragestellung: Ich benötige ein Makro, welches mir Bilder von einem Laufwerk in eine Excel zieht.

Ich versuche es so detailiert wie möglich aufzuschreiben.

Die Artikelnummer 1234567 - 7 stellig - steht in Zeile B. Das dazugehörige Bild ist auf dem Laufwerk G:\Foto\ zu finden. Hier gibt es noch unzählige Unterordner in denen das Bild versteckt sein kann. Ein weiteres "Problem" ist, dass die Artikelnummer auf dem Laufwerk manchmal auch noch Zusätze hat z.B. 1234567_3 ; 1234567_neu etc. Er soll wenn möglich nur die ersten 7 Zahlen suchen. Dateiendung ist immer JPG. Das Foto soll in A dargestellt werden und die Größe 1,7 mal 1,7 haben.

Hoffe, dass reicht euch an Informationen.

Vielen Dank!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Makro - Bilder ausführen

07.05.2024 10:33:42

Oberschlumpf

Hi,

1. Folgende Fragestellung: Ich benötige ein Makro, welches mir Bilder von einem Laufwerk in eine Excel zieht.

a) das ist keine Frage, sondern ein Auftrag!
b) "...in eine Excel... = sorry, aber kannst du nicht richtiges Deutsch schreiben? (musst du natürlich nich, aber ich bin ein Fan von korrekter Grammatik, etc)

2. Die Artikelnummer 1234567 - 7 stellig - steht in Zeile B.

hmm...??...B ist aber eine Spalte und nich eine Zeile...

3. Das Foto soll in A dargestellt werden und die Größe 1,7 mal 1,7 haben.

aha??...1,7 METER breit x 1,7 METER hoch oder wie???

4. Kannst du bitte per Upload eine Bsp-Datei mit genügend Bsp-Einträgen in den richtigen Zeilen/Spalten zeigen?

1 - 4 sind "nur meine" "Wünsche" an dich.
Vielleicht können andere auch helfen, ohne dass du 1 - 4 beantwortest.

Ciao
Thorsten

AW: Makro - Bilder ausführen

07.05.2024 12:07:38

JoWE

Hallo,
evtl. so?



Sub holeBild()

  Dim bild As Picture

  Set bild = ActiveSheet.Pictures.Insert("C:\Temp\" & Cells(2, 2).Text & ".jpg")

  With bild

   .Left = ActiveSheet.Range("A" & 2).Left + 2

   .Top = ActiveSheet.Range("A" & 2).Top + 3

   .Width = Application.CentimetersToPoints(1.7)

   .Height = Application.CentimetersToPoints(1.7)

   .Placement = 1

  End With

End Sub

Gruß
Jochen

AW: Makro - Bilder ausführen

07.05.2024 14:44:38

Onur

Hier ist kein Auftragsdienst (auch wenn das einige Kollegen offenbar anders sehen) - hier kannst du Hilfe bei kleineren Problemen bekommen.

AW: Makro - Bilder ausführen

07.05.2024 22:39:51

Piet

Hallo

@Thorsten - ich habe jetzt erst den Code deiner Beispieldatei getestet. Der läuft ja Prima!! Alle Achtung!!
Man müsste dann nur den Pfad für jeden Unterordner in deinem Makro anpassen.

Da reicht es die Ordner OHNE Dateien aufzulisten und einen Ordner nach dem anderen abzuarbeiten.
Andererseits hat man beim vollständigen auflisten alle Dateinamen aufgelistet. Das ist auch ein Vorteil.
Nun ja, jetzt kann der TA ja mit den Möglichkeiten spielen. Ich bin gespannt was er austüfftelt?

mfg Piet

AW: Makro - Bilder ausführen

07.05.2024 15:27:23

SaschaL

Hab eure Kritik verstanden und mich jetzt auch nochmal selbst dran gesetzt und folgendes konnte ich schon lösen.

Sub DurchsucheUndLadeFotos()

    Dim ws As Worksheet

    Dim LastRow As Long

    Dim i As Long

    Dim Artikelnummer As String

    Dim BildPfad As String

    Dim Pic As Picture

    Dim ImgWidth As Double

    Dim ImgHeight As Double

    Dim OrdnerPfad As String

    Set ws = ThisWorkbook.Sheets("Tabelle1")

    OrdnerPfad = "G:\Foto\Aktuell\2020\11\02.11\hochgeladen\"

     BildPfad = Dir(OrdnerPfad & "*.jpg", vbDirectory)

    LastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row    

    For i = 1 To LastRow

        Artikelnummer = ws.Cells(i, "B").Value        

        BildPfad = OrdnerPfad & Artikelnummer & ".jpg"        

        If Dir(BildPfad) > "" Then

            Set Pic = ws.Pictures.Insert(BildPfad)

            With ws.Cells(i, "B")               

                Pic.ShapeRange.LockAspectRatio = msoTrue

                Pic.Width = Application.CentimetersToPoints(1.7)

                Pic.Height = Application.CentimetersToPoints(1.7)

                ' Zelle in Spalte A auf die gleiche Größe anpassen

                .ColumnWidth = Application.CentimetersToPoints(1.7)

                .RowHeight = Application.CentimetersToPoints(1.7)

            End With

            Pic.Top = ws.Cells(i, "B").Top

            Pic.Left = ws.Cells(i, "B").Left + ws.Cells(i, "B").Width

        Else

            MsgBox "Foto für Nummer " & Artikelnummer & " nicht gefunden."

        End If

    Next i

End Sub

Mein Problem ist nun folgendes :

Ich würde gerne wissen, wie ich es schaffe, dass er nicht nur hier sucht OrdnerPfad = "G:\Foto\Aktuell\2020\11\02.11\hochgeladen\" sondern quasi bei G:\Foto\Aktuell anfängt zu suchen bis er das Foto im Unterordner gefunden hat.

AW: Makro - Bilder ausführen

07.05.2024 15:31:08

Onur

Schau dir DAS mal an:
https://www.online-vba.de/vba_readfolder.php

AW: Makro - Bilder ausführen

07.05.2024 17:02:09

Oberschlumpf

Hi Sascha,

so, bin auch wieder da, mit Lösung ;-) Ich musste zwischendurch etwas anderes erledigen.

Hier, probier mal...
https://www.herber.de/bbs/user/169331.xlsm

Ich hab mich, unter anderem, der schon gezeigten Code-Bsp bedient, alles in der Bsp-Datei zusammengebracht = funktioniert :-)

Beachte den Hinweis bzgl des Startverzeichnisses im Code!

Und wenn es bei dir noch nicht läuft, dann lad dir diese ZIP-Datei runter (alles zusammen größer als 2MB, deswegen muss ich auf meine GMX-Cloud ausweichen):
https://c.gmx.net/@334256655850015599/8kC1l42pSJ6tEFKdxAKYaQ

Diese ZIP-Datei enthält meine Testumgebung mit Ordnern, Unterordnern und darin sich befindenen Bsp-JGP-Dateien.

Entpack die ZIP-Datei in einem Verzeichnis, Name egal, z Bsp in G:\Test.
Änder im Code das Startverzeichnis um in "G:\Test"
Starte mein Makro
Jetzt funktioniert es - zumindest bei mir.

Hilfts?

Ciao
Thorsten

AW: Makro - Bilder ausführen

07.05.2024 22:23:23

Piet

Hallo

ich habe dir mal meine Beispieldatei mit deinem Code hochgeladen. - Mein Code listet die Bilder von Thorsten auf!
Leere Ordner werden übersprungen. Jetzt musst du deinen BilderPfad auf den passenden Ordnerpfad anpassen.
Ist diese Möglichkeit eine Alternative für dich?? - Diese Auflistung kann auch in einem separatem Sheet erfolgen.
Du siehst sofort welche Bilder in allen Unterordnern vorhanden sind.
https://www.herber.de/bbs/user/169340.xls

mfg Piet

AW: Makro - Bilder ausführen

07.05.2024 10:46:45

SaschaL

Hi Thorsten,

danke für deine schnelle Antwort :)

Entschuldige die Unannehmlichkeiten in meinem Auftrag.

1. Folgende Fragestellung: Ich benötige ein Makro, welches mir Bilder von einem Laufwerk in eine Excel zieht.

a) das ist keine Frage, sondern ein Auftrag! Sorry dafür - ich habe eine Fragestellung und bräuchte dabei Hilfe....
b) "...in eine Excel... = sorry, aber kannst du nicht richtiges Deutsch schreiben? (musst du natürlich nich, aber ich bin ein Fan von korrekter Grammatik, etc) Natürlich würde ich es sehr gerne in einer Excel - Datei bekommen.

2. Die Artikelnummer 1234567 - 7 stellig - steht in Zeile B.

hmm...??...B ist aber eine Spalte und nich eine Zeile... Du hast Recht - ich hätte schreiben können Spalte B und Zeile B1, B2 , B3

3. Das Foto soll in A dargestellt werden und die Größe 1,7 mal 1,7 haben.

aha??...1,7 METER breit x 1,7 METER hoch oder wie??? Gerne in cm.

4. Kannst du bitte per Upload eine Bsp-Datei mit genügend Bsp-Einträgen in den richtigen Zeilen/Spalten zeigen?
Gerne : https://www.herber.de/bbs/user/169317.xlsx

Beliebteste Forumthreads (12 Monate)

Makro - Bilder ausführen

Forumthread: Makro - Bilder ausführen

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread