如何设置窗体属性，使之完整打印在A4纸张上

liuxuwentiger

在下制作了一个窗体，上面画了一个图像框，插入一张A4像素大小的图片后，需要完整吧图像打印在A4纸上。
请教达人，使用PrinteForm语句可以打印窗体，但是怎么设置才可以把图相框里的图片完整打印出来呢？
请赐教，谢谢了。

yaozong

http://www.excelpx.com/thread-148041-1-1.html

VBA万岁

yaozong 发表于 2013-3-13 22:14
http://www.excelpx.com/thread-148041-1-1.html

套用2楼所介绍帖子（非本论坛）的代码，写了个横向打印窗体内容的的代码：
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.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const VK_MENU = &H12   'Alt键
Const VK_SNAPSHOT = &H2C  'PrintScrn键
Const KEYEVENTF_KEYUP = &H2

Private Sub CommandButton1_Click()
On Error Resume Next
Dim alt_scan_code As Long
   
' 模拟键盘按键Alt+PrtSc,复制当前窗口位图到剪贴板。
alt_scan_code = MapVirtualKey(VK_MENU, 0)
keybd_event VK_MENU, alt_scan_code, 0, 0    ' 模拟按Alt键
keybd_event VK_SNAPSHOT, 0, 0, 0            ' 模拟按PrintScrn键
DoEvents                                    ' 转让控制权，以便让操作系统处理其它的事件。
keybd_event VK_MENU, alt_scan_code, KEYEVENTF_KEYUP, 0  '释放按键
   
' 粘贴剪贴板里图片到工作表,调整成横向打印后打印预览
With Workbooks.Add(xlWBATWorksheet).ActiveSheet
    .Paste                      ' 粘贴图片到工作表
   .PageSetup.Orientation = xlLandscape
    .PageSetup.EvenPage.RightHeader.Text = ""
    .PageSetup.EvenPage.LeftFooter.Text = ""
    Application.PrintCommunication = True
    Unload Me   ' 关闭当前窗口,如果是非模态窗口的话也许不用关闭.
    .PrintPreview   ' 预览贴了图片的工作表
End With
End Sub

VBA万岁

VBA万岁 发表于 2015-5-27 11:51
套用2楼所介绍帖子（非本论坛）的代码，写了个横向打印窗体内容的的代码：
Private Declare Function Ma ...

附件：
订票日历.zip (82.32 KB, 下载次数: 272)

2015-5-27 12:39 上传

点击文件名下载附件

VBA万岁

VBA万岁 发表于 2015-5-27 11:51
套用2楼所介绍帖子（非本论坛）的代码，写了个横向打印窗体内容的的代码：
Private Declare Function Ma ...

改进一下：

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.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const VK_MENU = &H12   'Alt键
Const VK_SNAPSHOT = &H2C  'PrintScrn键
Const KEYEVENTF_KEYUP = &H2

Private Sub CommandButton1_Click()
On Error Resume Next
Dim alt_scan_code As Long, shp
   
' 模拟键盘按键Alt+PrtSc,复制当前窗口位图到剪贴板。
alt_scan_code = MapVirtualKey(VK_MENU, 0)
keybd_event VK_MENU, alt_scan_code, 0, 0    ' 模拟按Alt键
keybd_event VK_SNAPSHOT, 0, 0, 0            ' 模拟按PrintScrn键
DoEvents                                    ' 转让控制权，以便让操作系统处理其它的事件。
keybd_event VK_MENU, alt_scan_code, KEYEVENTF_KEYUP, 0  '释放按键
   
' 粘贴剪贴板里图片到工作表,调整成横向打印后打印预览
With Workbooks.Add(xlWBATWorksheet).ActiveSheet
    .Paste                      ' 粘贴图片到工作表
    .PageSetup.Orientation = xlLandscape
    .PageSetup.LeftMargin = Application.InchesToPoints(0)
    .PageSetup.RightMargin = Application.InchesToPoints(0)
    Application.PrintCommunication = True
   
    For Each shp In .Shapes
        shp.ScaleWidth 0.88, msoFalse, msoScaleFromTopLeft
        shp.ScaleHeight 0.9, msoFalse, msoScaleFromTopLeft
        shp.IncrementTop 78
    Next
   
    Unload Me   ' 关闭当前窗口,如果是非模态窗口的话也许不用关闭.
    .PrintPreview   ' 预览贴了图片的工作表
End With
End Sub

02761752696

学习    谢谢

liuxuwentiger

学习了，谢谢谢