userform drucken - Screenshots zusammenfügen
18.12.2007 08:46:38
chris
habe mit hilfe des forums einen code gefunden um eine userform komplett zu drucken.(unten)
Nur leider weiß ich noch keine gute lösung um die 3 Screenshots zusammenzufügen
(Screenshot 2 unter 1 und 3 unter 2)
So das es auf dem asdruck als zusammen angezeigt wird.
so das der Ausdruck auf 2 Seiten gedruckt wird.
Wüerde mich sehr über hilfe freuen.
Vielen dank an Alle !!
gruß Chris
'Code in userform zum aufrufen des drucks
Private Sub drucken_Click()
Dim newHour, newMinute, newSecond, waitTime, x
x = Me.Height
Me.ScrollTop = 1 ' set scroll area
Me.Height = 650
Me.Repaint
Call prcPrintForm(Me)
Me.ScrollTop = 610 ' set scroll area
Me.Height = 300
Me.Repaint
Call prcPrintForm(Me)
Me.Height = 700
Me.ScrollTop = 1500 ' set scroll area
Me.Repaint
Call prcPrintForm(Me)
Me.Height = x
End Sub
'code in StandartModul
Option Explicit
Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" ( _
ByVal wCode As Long, _
ByVal wMapType As Long) As Long
Private Declare Sub keybd_event Lib "user32" ( _
ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long)
Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_MENU = &H12
'Private Const lngMargin = 1& 'Breite der Seitenränder in cm
Public Sub prcPrintForm(objForm As Object)
Dim intAltScan As Integer, intIndex As Integer
Application.ScreenUpdating = False
intAltScan = MapVirtualKey(VK_MENU, 0&)
keybd_event VK_MENU, intAltScan, 0&, 0&
keybd_event vbKeySnapshot, 0&, 0&, 0&
DoEvents
keybd_event VK_MENU, intAltScan, KEYEVENTF_KEYUP, 0&
Worksheets("ausdruck").Select
Worksheets("ausdruck").Rows.RowHeight = 3
Worksheets("ausdruck").Columns.ColumnWidth = 0.83
With ActiveSheet
.Cells(1, 1).Select
.Paste
Selection.ShapeRange.PictureFormat.CropBottom = 13.5
Selection.ShapeRange.PictureFormat.CropRight = 15#
Selection.ShapeRange.PictureFormat.CropTop = 16.5
With .PageSetup
.Orientation = 1
' .LeftMargin = Application.CentimetersToPoints(lngMargin)
' .RightMargin = Application.CentimetersToPoints(lngMargin)
' .TopMargin = Application.CentimetersToPoints(lngMargin)
' .BottomMargin = Application.CentimetersToPoints(lngMargin)
.HeaderMargin = Application.CentimetersToPoints(0)
.FooterMargin = Application.CentimetersToPoints(0)
' .CenterVertically = True
' .CenterHorizontally = True
' .Zoom = 10
' For intIndex = 1 To 3
' Do Until ExecuteExcel4Macro("Get.Document(50)") > 1
' .Zoom = .Zoom + Choose(intIndex, 50, 10, 1)
' Loop
' .Zoom = .Zoom - Choose(intIndex, 50, 10, 1)
' Next
End With
' .PrintOut
End With
Application.ScreenUpdating = True
Worksheets("start").Select
End Sub