Live-Forum - Die aktuellen Beiträge
Datum
Titel
23.04.2024 10:55:14
Zeilen sortieren
23.04.2024 10:23:52
Tabelle 90° drehen + Filteroptionen
23.04.2024 10:11:03
Dateiname plus Wenn vorhanden dann "(1)" anhängen.
23.04.2024 09:45:43
mehrere Bedingungen verknüpfen und mehr
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1628to1632
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
1628to1632
1628to1632
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Bild einfügen

Bild einfügen
20.06.2018 09:50:21
Janine
Moin
Ich möchte in einer neu erstellen Excel Tabelle ein Bild einfügen. Das Bild trägt den gleichen Namen wie die neu erstellte Tabelle. Wenn kein Bild vorhanden ist, soll der Code einfach weiter laufen.
Im Internet bin nicht wirklich schlau geworden. Kenn mich noch nicht so gut aus mit VBA.
Die Tabelle wird durch folgendem Code erstellt:
Sub Mitarbeiter()
Dim NewName As String
With Sheets("Mitarbeiter")
Dim Zeile As Long                                          'Zeile wählen'
Zeile = Selection.Row
Cells(Zeile, 1).Copy
Sheets("Mitarbeiter").Range("B6").PasteSpecial xlPasteAll  'Vorname*
Cells(Zeile, 2).Copy
Sheets("Mitarbeiter").Range("E6").PasteSpecial xlPasteAll  'Nachname'
Cells(Zeile, 3).Copy
Sheets("Mitarbeiter").Range("B7").PasteSpecial xlPasteAll  'Wohnort'
Cells(Zeile, 4).Copy
Sheets("Mitarbeiter").Range("E7").PasteSpecial xlPasteAll   'Abteilung'
.Copy After:=Sheets("Mitarbeiter")                         'Tabelle kopieren'
End With
ActiveSheet.Name = CStr(Range("B6"))                        'Name Vergeben'
ActiveSheet.Range("C5").Value = "Mitarbeiter"               'Wert auswählen'
Sheets("Mitarbeiter").Range("B6,B7,E6,E7").ClearContents    'Daten löschen'
ActiveSheet.Move                                           'Tabelle verschieben in neuer  _
Datei'
ActiveWorkbook.SaveAs ThisWorkbook.Path & "/" & "Mitarbeiter" & Range("B6") 'speichern'
End Sub

Zum besseren Verständnis noch eine Beispiel Datei:
https://www.herber.de/bbs/user/122199.xlsm
Gruß Janine

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bild einfügen
20.06.2018 10:54:59
Nepumuk
Hallo Janine,
1. In welchem Pfad liegt das Bild?
2. In welcher Zelle soll die obere linke Ecke des Bildes liegen?
3. Was steht in Zelle B6 (Beispiel)?
4. In welchem Format (xlsx / xlsm / xlsb) soll die Datei gespeichert werden?
Gruß
Nepumuk
AW: Bild einfügen
20.06.2018 12:51:07
Janine
Moin
Der Pfad wäre C:\Bilder. Das Bild soll in der Zelle B9 anfangen. Die Größe kann später manuell angepasst werden. In der Zelle B6 steht in diesem Beispiel der Name des Mitarbeiters, je nach dem welche Zeile ausgewählt wird ändert sich der. Soll unter .xlsm gespeichert werden.
Gruß Janine
AW: Bild einfügen
20.06.2018 13:30:38
Nepumuk
Hallo Janine,
teste mal (Das Makro kannst du für beide Listen benutzen):
Option Explicit
Option Private Module

Public Sub Mitarbeiter()
    
    Const PICTURE_PATH As String = "C:\Bilder\" 'gegebenenfalls anpassen
    
    Dim lngRow As Long
    Dim strWorksheetType As String
    
    With ActiveSheet
        
        strWorksheetType = IIf(ActiveSheet.Name = "Mitarbeiter Liste", "Mitarbeiter", "Urlaub")
        
        lngRow = Selection.Row 'Zeile wählen
        Call .Cells(lngRow, 1).Copy(Destination:=Worksheets("Mitarbeiter").Range("B6")) 'Vorname
        Call .Cells(lngRow, 2).Copy(Destination:=Worksheets("Mitarbeiter").Range("E6")) 'Nachname
        Call .Cells(lngRow, 3).Copy(Destination:=Worksheets("Mitarbeiter").Range("B7")) 'Wohnort
        Call .Cells(lngRow, 4).Copy(Destination:=Worksheets("Mitarbeiter").Range("E7")) 'Abteilung
        Range("C5").Value = strWorksheetType 'Wert auswählen
        
    End With
    With Worksheets("Mitarbeiter")
        
        .Copy 'Tabelle kopieren
        .Range("B6,B7,E6,E7").ClearContents 'Daten löschen
        
    End With
    With ActiveSheet
        
        .Name = .Range("B6").Text 'Name Vergeben
        If Dir$(PICTURE_PATH & .Range("B6").Text, vbNormal) <> vbNullString Then 'testen ob Bild Vorhanden
            Call .Shapes.AddPicture(Filename:=PICTURE_PATH & Range("B6").Text, LinkToFile:=msoFalse, _
                SaveWithDocument:=msoTrue, Left:=.Range("B9").Left, Top:=.Range("B9").Top, Width:=-1, Height:=-1) 'Bild einfügen
        End If
        
        Call ActiveWorkbook.SaveAs(Filename:=ThisWorkbook.Path & "\" & strWorksheetType & "_" & .Range("B6").Text, _
            FileFormat:=xlOpenXMLWorkbookMacroEnabled) 'speichern
        
    End With
End Sub

Gruß
Nepumuk
Anzeige
AW: Bild einfügen
20.06.2018 13:55:38
Janine
Hallo Nepumuk,
vielen Dank für die Hilfe.
Hab den Code getestet.
Leider klappt es nicht, er fügt kein Bild ein. Obwohl eins definitiv vorhanden ist, in dem Ordner. Hast du ne Idee voran das liegen könnte?
Gruß Janine
AW: Bild einfügen
20.06.2018 14:00:09
Nepumuk
Hallo Janine,
schwierig, da ich deine Arbeitsumgebung nicht kenne. Hast du was geändert, wenn ja, was?
Gruß
Nepumuk
AW: Bild einfügen
20.06.2018 14:04:48
Janine
Moin Nepumuk,
hab den Code komplett von dir so gelassen. Der Pfad ist eigentlich richtig so.
Gruß
Janine
AW: Bild einfügen
20.06.2018 14:07:17
Nepumuk
Hallo Janine,
jetzt fällt es mit wie Schuppen aus den Haaren.
Die Dateiendung des Bildes fehlt. Wie lautet die denn (.jpg, .gif, .bmp ....)
Gruß
Nepumuk
Anzeige
AW: Bild einfügen
20.06.2018 14:10:54
Janine
Hallo Nepumuk
Die Endung ist .jpg. Wo muss ich das dann einfügen?
Daran liegt es bestimmt. Hab gerade den Code getestet ohne das er kontrolliert ob das Bild vorhanden ist. Dann kommt ein Fehler wo er sagt die Datei konnte nicht gefunden werden.
Gruß Janine
AW: Bild einfügen
20.06.2018 14:16:22
Nepumuk
Hallo Janine,
der getestete Code:
Option Explicit
Option Private Module

Public Sub Datenblatt()
    
    Const PICTURE_PATH As String = "C:\Bilder\" 'gegebenenfalls anpassen
    Const PICTURE_EXTENSION As String = ".jpg"
    
    Dim lngRow As Long
    Dim strWorksheetType As String
    
    With ActiveSheet
        
        strWorksheetType = IIf(.Name = "Mitarbeiter Liste", "Mitarbeiter", "Urlaub")
        
        lngRow = Selection.Row 'Zeile wählen
        Call .Cells(lngRow, 1).Copy(Destination:=Worksheets("Mitarbeiter").Range("B6")) 'Vorname
        Call .Cells(lngRow, 2).Copy(Destination:=Worksheets("Mitarbeiter").Range("E6")) 'Nachname
        Call .Cells(lngRow, 3).Copy(Destination:=Worksheets("Mitarbeiter").Range("B7")) 'Wohnort
        Call .Cells(lngRow, 4).Copy(Destination:=Worksheets("Mitarbeiter").Range("E7")) 'Abteilung
        Worksheets("Mitarbeiter").Range("C5").Value = strWorksheetType 'Wert auswählen
        
    End With
    With Worksheets("Mitarbeiter")
        
        Call .Copy 'Tabelle kopieren
        Call .Range("B6,B7,E6,E7").ClearContents 'Daten löschen
        
    End With
    With ActiveSheet
        
        .Name = .Range("E6").Text 'Name Vergeben
        If Dir$(PICTURE_PATH & .Range("E6").Text & PICTURE_EXTENSION, vbNormal) <> vbNullString Then 'testen ob Bild Vorhanden
            Call .Shapes.AddPicture(Filename:=PICTURE_PATH & .Range("E6").Text & PICTURE_EXTENSION, _
                LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=.Range("B9").Left, _
                Top:=.Range("B9").Top, Width:=-1, Height:=-1) 'Bild einfügen
        End If
        
        Call ActiveWorkbook.SaveAs(Filename:=ThisWorkbook.Path & "\" & strWorksheetType & "_" & _
            .Range("E6").Text, FileFormat:=xlOpenXMLWorkbookMacroEnabled) 'speichern
        
    End With
End Sub

Gruß
Nepumuk
Anzeige
AW: Bild einfügen
20.06.2018 14:24:15
Janine
Hallo Nepumuk
Nun klappt es perfekt.
Vielen Dank!!
Gruß Janine
AW: Bild einfügen
22.06.2018 09:47:15
Janine
Moin
Hab mein gelöstes Problem noch mal hervor geholt.
Gibt es auch die Möglichkeit den Pfad als relativen Pfad anzugeben? Die Bilder befinden sich in einem Unterordner von der Hauptdatei.
Da verschiedene Leute an der Datei arbeiten, dadurch weiß ich nicht wo die den Ordner speichern.
Wäre daher einfacher wenn das ginge.
Gruß Janine
AW: Bild einfügen
22.06.2018 10:18:04
Nepumuk
Hallo Janine,
du müsstest dann an Stelle von:
Const PICTURE_PATH As String = "C:\Bilder\" 'gegebenenfalls anpassen

Das machen:
Dim strPicturePath As String
strPicturePath = Thisworkbook.Path & "\Unterordner\" 'Unterordner anpassen

Und dann im Makro alle PICTURE_PATH durch strPicturePath ersetzen.
Gruß
Nepumuk
Anzeige
AW: Bild einfügen
22.06.2018 10:23:07
Janine
Moin Nepumuk
Klappt super. Vielen Dank für die schnelle Hilfe.
Gruß Janine
AW: Bild einfügen
20.06.2018 13:50:45
Nepumuk
Ooooooooooops,
da war noch ein Fehler drin. Also nochmal:
Option Explicit
Option Private Module

Public Sub Datenblatt()
    
    Const PICTURE_PATH As String = "C:\Bilder\" 'gegebenenfalls anpassen
    
    Dim lngRow As Long
    Dim strWorksheetType As String
    
    With ActiveSheet
        
        strWorksheetType = IIf(.Name = "Mitarbeiter Liste", "Mitarbeiter", "Urlaub")
        
        lngRow = Selection.Row 'Zeile wählen
        Call .Cells(lngRow, 1).Copy(Destination:=Worksheets("Mitarbeiter").Range("B6")) 'Vorname
        Call .Cells(lngRow, 2).Copy(Destination:=Worksheets("Mitarbeiter").Range("E6")) 'Nachname
        Call .Cells(lngRow, 3).Copy(Destination:=Worksheets("Mitarbeiter").Range("B7")) 'Wohnort
        Call .Cells(lngRow, 4).Copy(Destination:=Worksheets("Mitarbeiter").Range("E7")) 'Abteilung
        Worksheets("Mitarbeiter").Range("C5").Value = strWorksheetType 'Wert auswählen
        
    End With
    With Worksheets("Mitarbeiter")
        
        .Copy 'Tabelle kopieren
        .Range("B6,B7,E6,E7").ClearContents 'Daten löschen
        
    End With
    With ActiveSheet
        
        .Name = .Range("B6").Text 'Name Vergeben
        If Dir$(PICTURE_PATH & .Range("B6").Text, vbNormal) <> vbNullString Then 'testen ob Bild Vorhanden
            Call .Shapes.AddPicture(Filename:=PICTURE_PATH & Range("B6").Text, LinkToFile:=msoFalse, _
                SaveWithDocument:=msoTrue, Left:=.Range("B9").Left, Top:=.Range("B9").Top, Width:=-1, Height:=-1) 'Bild einfügen
        End If
        
        Call ActiveWorkbook.SaveAs(Filename:=ThisWorkbook.Path & "\" & strWorksheetType & "_" & .Range("B6").Text, _
            FileFormat:=xlOpenXMLWorkbookMacroEnabled) 'speichern
        
    End With
End Sub

Gruß
Nepumuk
Anzeige

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige