Mehrere Bilder aus Datei in neue Datei
21.09.2021 09:04:06
Christina
Ich versuche immer noch mehrere Bilder aus einer Datei in eine neue einzufügen. Die Bilder sind jeweils in einer Zelle einer Spalte.
Private Sub CommandButton_OK_Click()
Dim Bestellung As Workbook
Dim Basisdaten As Workbook
Dim strFileName As Variant
Dim Zelle As Object
Dim i As Long
Dim v As String
Const strDateiname = "C:\Users\cg\Desktop\Test.xlsx"
'Vorlage öffnen
Set Bestellung = Workbooks.Open(strDateiname, UpdateLinks:=False, ReadOnly:=True)
'Bestellung unter Zielname speichern
ThisWorkbook.Activate
Bestellung.SaveAs strPfad & ActiveSheet.Range("B2").Value & " " & ActiveSheet.Range("D2").Value & ".xls"
'Basis öfnen
Set Basisdaten = BasisDatei_öffnen
If Not Basisdaten Is Nothing Then
MsgBox "Die Datei '" & Basisdaten.Name & "' wurde geöffnet.", vbInformation, "Hinweis"
'Daten übertragen
On Error Resume Next
With Basisdaten.Worksheets("Fenster- und Terrassentüren")
For i = 3 To 40
Bestellung.Worksheets("fenster").Cells(i + 6, 1) = .Cells(i, 1).Value 'Spalte A = Spalte-Nr 1
Bestellung.Worksheets("fenster").Cells(i + 6, 2) = .Cells(i, 2).Value 'Spalte B = Spalte-Nr 2
Bestellung.Worksheets("fenster").Cells(i + 6, 3) = .Cells(i, 3).Value 'usw.
Bestellung.Worksheets("fenster").Cells(i + 6, 4) = .Cells(i, 4).Value
Bestellung.Worksheets("fenster").Cells(i + 6, 5) = Split(.Cells(i, 5).Value, "x")(0) 'in Spalte E, der Teil vor dem "x"
Bestellung.Worksheets("fenster").Cells(i + 6, 6) = Split(.Cells(i, 5).Value, "x")(1) 'in Spalte E, der Teil nach dem "x"
Bestellung.Worksheets("fenster").Cells(i + 6, 7) = .Cells(i, 8).Value
Next i
End With
Worksheets("Fenster- und Terrassentüren").Shapes.SelectAll
With Basisdaten.Worksheets("Fenster- und Terrassentüren")
Bestellung.Worksheets("fenster").Shapes.Range("H9:H36") = .Shapes.Range("I3:I30")
End With
End If
Bestellung.Save
End Sub
Danke!!
LG
Christina