396 Aufrufe
Gefragt in Tabellenkalkulation von
Bearbeitet
Hallo an die Spezialisten!

Ich hätte da eine Frage, vielleicht könnt ihr mir weiter Helfen.

Ich habe mir nun eine Datenbank in Mappe 1 erstellt, in Mappe 2 Befindet sich meine Vorlagemaske, welche mit SVERWEIS schon richtig befüllt wird.

Nun wollte ich euch fragen ob es möglich wäre, die dazugehörigen Bilder auch automatisch einfügen zu lassen.

ZB OZ10 (Name) steht in Zelle J2, nun möchte ich das dazugehörige Foto aus dem Ordner OZ10 aber in Zelle E66 einfügen.

Meine Frage, gibt es Makros die Spalte mit den Ordner abgleicht und daraus dann 2 Bilder (zb 1 und 2) in eine Zelle in bestimmter größe (8x10cm) ausspielt?

Wäre dankbar wenn jemand einen Tipp hat (ohne womöglich meine gesamten Bilder auszuwählen und umzubenennen). Leider helfen mir die anderen Makros nicht weiter.

Danke.

LG

Hier im Anhang findet ihr meinen bisherigen Code:

Bild wird schon in richtiger Größe geladen, aber leider schaff ich es nicht dieses in einer bestimmten Zelle darzustellen.

Vermutlich wird mir denk ich auch nichts anderes übrig bleiben, als einen Ordner mit allen Bildern mit Namenszuordnung anzulegen. So wird dan leider nur ein Bild eingefügt.

Sub BilderImport()

Dim strVerzeichnis$, strDatei$
Dim pct As Picture
Dim lngZeile As Long 'Zeile zum Eintragen der Bilder
Dim lngSpalte As Long 'Spalte zum Eintragen der Bilder
Dim varBreite As Variant 'Spaltenbreite
Dim varHoehe As Variant

 
'** Verzeichnis und Dateinamen definieren und auslesen
strVerzeichnis = "P:\Test\Foto1"
strDatei = Dir(strVerzeichnis & "\*.jpg")

 
'** Startzeile + Spalte festelegen
lngZeile = 2
lngSpalte = 7

'** Ermittlung der Spaltenbreite
varBreite = Columns("F:F").Width

Cells(lngZeile, lngSpalte).Select
'Cells(lngZeile, lngSpalte + 1) = strDatei  ' schreiben Dateinamen

Set pct = ActiveSheet.Pictures.Insert(strVerzeichnis & "\" & strDatei)
'With ActiveSheet.Shapes("Picture 1")

'** Auslesen der Breite
With pct
.Top = 200
.Left = 400
.Width = 400
.Height = 200
End With

shp = 2

lngZeile = lngZeile + 1

Do While strDatei <> ""

strDatei = Dir()

If strDatei = "" Then Exit Do

Cells(lngZeile, lngSpalte).Select

Set pct = ActiveSheet.Pictures.Insert(strVerzeichnis & "\" & strDatei)

 

 

shp = shp + 1

Loop
End Sub

7 Antworten

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)

Hallo,

wenn der Bildname und der Pfad, in dem das Bild liegt, bekannt sind, dann kannst du das Bild auch per VBA skaliert in die Tabelle einfügen.

Bisher verstehe ich nur, dass in J2 der Bildname steht (Bildname auch gleich Name des Verzeichnisses??) und das Bild skaliert in Zelle E 66 eingfügt werden soll (10 x 20 cm sind ziemlich groß).

Aber was meinst du mit

gibt es Makros die Spalte mit den Ordner abgleicht

und daraus dann 2 Bilder (zb 1 und 2) in eine Zelle (..) ausspielt

Und welche anderen Makros helfen dir nicht weiter?

Gruß

M.O.

0 Punkte
Beantwortet von
Danke für die Antwort.

Ich versuche es nochmal besser zu erklären.

Ich habe ein 2 seitiges Protokoll erstellt, welches mit meiner Datenbank in der zweiten Mappe verknüpft ist. Wenn ich den den Artikelnamen (zb Bohrmaschine) ändere, werden nun automatisch alle Werte aus der Zeile "Bohrmaschine" sind verändert.

Nun möchte ich aber,  dass in einer speziellen Stelle auf meiner Protokollseite (Nehmen wir zb Zelle F66, zweite Seite) ein Bild automatisch an diese Position eingefügt wird, sobald ich meinen Artikelnamen ändere ("Bohrmaschine" zu "Kreissäge").

Das Problem ist, dass ich meine Bilder in Unterordner gespeichert habe zB enhält der Ordner "Elektronisches" hier meinen Ordner "Bohrmaschine" und "Kreissäge" mit 4 Bildern.

Ich würde nun gerne, sobald ich meinen Artikelnamen ändere, auch gleich das richtige Bild dazu haben.

Ich habe es nun mit Makros versucht. Es läd mir das Bild aus dem Testordner rein, jedoch ist es nicht richtig platziert. Ich müsste halt nun alle Bilder von meinen Artikel händisch umschreiben und in einen Ordner legen. Dem wollte ich umgehen.

Ich hoffe es ist nun verständlicher beschrieben.

Lg
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo,

so langsam sehe ich etwas klarer.

Wenn ich dich richtig verstehe soll das Makro folgendes machen:

Sobald du den Artikelnamen änderst (der in welcher Zelle steht?) sollen (alle?) Bilder aus dem entsprechenden Unterordner eingefügt werden. Dazu müsste das Makro den Ordner, in dem die Bilder liegen, inklusive der Unterordner durchsuchen (Verzeichnis "P:\Test\Foto1" inkl. eventuell vorhandener Unterordner?).

Die Bilder sollen in Zelle F66 (untereinander oder nebeneinander?) eingefügt werden.

Ist das so richtig?

Gruß

M.O.
0 Punkte
Beantwortet von
Guten Morgen!

Ja genau!
Die Bilder welche eingefügt werden sollen , sollen auf Seite zwei untereinander sein.
Vorgegebener Platz dafür ist F-Q von Zeilen 66-84    bzw das zweite Zeilen 94 - 113.

Bei meinem jetzigen Test habe ich einige Bilder nur in einem Suchordner zusammengefasst. Das einlesen funktioniert. Es lädt mir aber nun alle Bilder hinein, wobei nur das erste meine gewünschte Größe hat.

Danke nochmals für deine Hilfe

LG
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)

Hallo,

der folgende Code gehört in ein Standardmodul deiner Arbeitsmappe. Der Artikelname wird im Code aus der Zelle A2 eingelesen. Das musst du noch auf deine Verhältnisse anpassen, ebenso wie den Pfad. Das Makro ist aus deiner Protokollseite auszuführen. Sämtliche in der aktiven Tabellen vorhandenen Bilder werden gelöscht, bevor die neuen Bilder eingefügt werden. Es werden die ersten zwei Bilder eingefügt, die in dem gesuchten Unterordner gefunden werden. Falls du mehr als 100 Bilder hast, musst die Dimensionierung bei arrVerzeichnis entsprechend anpassen.

Hier der Code:

Dim arrVerzeichnis(100) As Variant
Dim lngZaehler As Long

Sub Bilder_einfuegen()
Dim strPfad As String
Dim strSuche As String
Dim shpBild As Shape
Dim i As Long
Dim b As Long

'Pfad in dem die Unterordner mit den Bildern liegen - ggf. anpassen
strPfad = "C:\Test\"

'Suchbegriff (= Artikelname) einlesen - Zelle anpassen
strSuche = Range("A2").Value

'Routine zum Einlesen der Unterverzeichnisse und Dateien aufrufen
Call MWReadSubFolder(strPfad)

'vorhandene Bilder im aktiven Blatt löschen
For Each shpBild In ActiveSheet.Shapes
    shpBild.Delete
Next

'Unterverzeichnis suchen
For i = 0 To lngZaehler - 1
  If InStr(1, arrVerzeichnis(i), strSuche) Then
      If b = 0 Then
        '1. Bild in F 66 skaliert 8 x 10 cm einfügen
        '1 cm = 28,35 pt; 1. Wert Breite, 2. Wert Höhe
        ActiveSheet.Shapes.AddPicture arrVerzeichnis(i), msoFalse, msoTrue, Range("F66").Left, Range("F66").Top, 283.5, 226.8
         b = b + 1
       End If
       If b = 1 Then
         '2. Bild in F 94 einfügen, ebenfalls skaliert
          ActiveSheet.Shapes.AddPicture arrVerzeichnis(i + 1), msoFalse, msoTrue, Range("F94").Left, Range("F94").Top, 283.5, 226.8
          Exit For               'Schleife verlassen
       End If
  End If
      
Next i

End Sub

Private Sub MWReadSubFolder(ByVal sPath As String)
'Autor/en des ursprünglichen Codes: http://www.online-vba.de - Marc Wershoven
'modifiziert
 
Dim oFSO As Object
Dim oFolder As Object
Dim oSubFolder As Object
Dim oFile As Object
    
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.getfolder(sPath)
    
For Each oSubFolder In oFolder.subfolders
  'Alle Dateien auflisten
   For Each oFile In oSubFolder.Files
        arrVerzeichnis(lngZaehler) = oSubFolder.Path & "\" & oFile.Name
        lngZaehler = lngZaehler + 1
   Next oFile
            
  'Alle Unterverzeichnisse verarbeiten (rekursiv)
  Call MWReadSubFolder(oSubFolder.Path)
        
Next oSubFolder
    
Set oFSO = Nothing
Set oFile = Nothing
Set oFolder = Nothing
Set oSubFolder = Nothing

End Sub


Beachte bitte, dass der Code genau so in das Modul kopiert werden muss.

Gruß

M.O.

0 Punkte
Beantwortet von
Danke. Wahnsinn. Es funktioniert...

Ich weiß gar nicht wie ich mich bedanken soll.

Du bist mega-spitze-super-Toll!!!

LG
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo,

vielen Dank für die Rückmeldung. Ich freue mich, dass das Makro so funktioniert, wie du dir das vorstellst.

Gruß

M.O.
...