Re: Problem mit Macro und Pfad
28.04.2003 14:30:06
Jörg
Hier nun ein Beispiel:Public Sub print_ausgabe_vit()
Dim lrow&
Dim Datei As String
Datei = ActiveSheet.name
Application.ScreenUpdating = False
Worksheets("Ausgabe Wartung").Unprotect "werte"
Sheets("Ausgabe Wartung").Select
Range("A1").Select
lrow = Cells(Rows.Count, 3).End(xlUp).Row
ActiveSheet.PageSetup.PrintArea = "$A$1:$D$" & lrow
Range("D1").Select
On Error GoTo ErrorHandler
ActiveSheet.Pictures.Insert("c:\eigene dateien\Logos\Vit.jpg").Select
With Selection
.ShapeRange.ScaleWidth 0.8, msoFalse, msoScaleFromTopLeft
.ShapeRange.ScaleHeight 0.8, msoFalse, msoScaleFromTopLeft
.Placement = xlMove
End With
With ActiveSheet.PageSetup
.CenterFooter = "Wartungszertifikat Seite &P von &N " & Sheets("Startseite").Range("D6").Value & " Serien-Nr.: " & Sheets("Startseite").Range("D8").Value
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1
ActiveSheet.Pictures.Delete
ActiveSheet.Protect "werte", DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets(Datei).Select
Application.ScreenUpdating = True
Exit Sub
ErrorHandler: MSGbox ("Es befinden sich keine Logos im Verzeichnis " & vbCrLf & "C:\Eigene Dateien")
End Sub
Gruß Jörg