Mehrere Bilder auf einem Blatt
10.09.2015 17:25:31
Dennis
ich hoffe mir kann jemand weiterhelfen.
Ich habe einen Code der mir bisher ein Bild auf einem Blatt mit andruckt, nun brauche ich das ganze mit weiteren 3 Bildern.
Ich komme aber nicht wirklich damit klar, ist auch schon lange her, das ich diesen Code Dank Hilfe hier aus dem Forum zusammen gebaut habe.
----------------------------------------------------------------------------------
Private Sub CommandButton1_Click()
Application.Dialogs(xlDialogPrinterSetup).Show
With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
ActiveWorkbook.PrecisionAsDisplayed = False
End With
If MsgBox("Alles berechnet!" & Chr(13) & "Richtiges Papier eingelegt?" & Chr(13) & " _
Jetzt drucken?", vbYesNo) = vbNo Then
Exit Sub
Else
'If MsgBox("Beidseitigen Druck eingestellt?", vbYesNo) = vbNo Then
'Exit Sub
'Else
Dim Counter As Integer
Dim n As Integer
Dim Fso As Object
Dim Pic As Picture, Dateiname As String
For Counter = 2 To Range("j3").Value
'Worksheets("Stapel auto").Cells(Counter, 9).Value = Counter
If Cells(Counter, 12) = 1 Then
Range("j1") = Cells(Counter, 11)
Set Fso = CreateObject("Scripting.FileSystemObject")
Dateiname = Range("j2")
'Dateiname = "L:\Eigene Dateien\Hajo\" & Range("H2")
If Fso.FileExists(Dateiname) Then
Set Pic = ActiveSheet.Pictures.Insert(Range("j2").Value)
With ActiveSheet.Range("A3:F24")
Pic.Left = .Left
Pic.Top = .Top
Pic.Width = .Width
Pic.Height = .Height
End With
For i = 1 To Int(Cells(Counter, 12) / 50) + 1
ActiveSheet.PrintOut
Next i
Pic.Select
Selection.Delete
Else
For i = 1 To Int(Cells(Counter, 12) / 50) + 1
ActiveSheet.PrintOut
Next i
End If
End If
n = n - (Cells(Counter, 12) = 1)
Next Counter
MsgBox ("Das war's:" & " " & n & " " & "Stapelanhänger gedruckt")
'End If
End If
Set Fso = Nothing
End Sub
vielleicht hat einer eine schnelle Idee.
Danke im Voraus