vb编程使用USB打印图片到A4纸

以下是一种方法：

用USB连打印机的电脑（假设是PC），把PC里面的打印机 >> 选择打印机内容 >> 共用 >> 共享出来（比如共用名是Printer）

Dim myFSO As Object
Set myFSO = CreateObject("ScriptingFileSystemObject")
myFSOCopyFile "文件路径" "＼＼PC名字(或IP)＼Printer"

这实现要分两步走：

步骤一）先要将含各种控件的Picturebox图像保存为。

步骤二）用画图板软件打印或编辑VB程序加载打印。

提供步骤一的代码：

Option Explicit
    Private Const BI_RGB = 0&
    Private Const DIB_RGB_COLORS = 0
    Private Const BITMAPTYPE = &H4D42
    Private Const INVALID_HANDLE_VALUE = (-1)
    Private Const GENERIC_WRITE = &H40000000
    Private Const CREATE_ALWAYS = 2
    Private Const FILE_ATTRIBUTE_NORMAL = &H80
    Private Type BITMAPINFOHEADER '40 bytes
        biSize As Long
        biWidth As Long
        biHeight As Long
        biPlanes As Integer
        biBitCount As Integer
        biCompression As Long
        biSizeImage As Long
        biXPelsPerMeter As Long
        biYPelsPerMeter As Long
        biClrUsed As Long
        biClrImportant As Long
    End Type
    Private Type RGBQUAD
        rgbBlue As Byte
        rgbGreen As Byte
        rgbRed As Byte
        rgbReserved As Byte
    End Type
    Private Type BITMAPINFO
        bmiHeader As BITMAPINFOHEADER
        bmiColors As RGBQUAD
    End Type
    Private Type BITMAPFILEHEADER
        bfType As Integer
        bfSize As Long
        bfReserved1 As Integer
        bfReserved2 As Integer
        bfOffBits As Long
    End Type
    Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
    Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
    Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
    Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
    Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
    Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Sub CmdSave_Click()
    '保存转换后的图像
    Dim hmemDC As Long
    Dim hmemBMP As Long
    Dim lpmemBits As Long
    Dim bmp_info As BITMAPINFO
    Dim hFile As Long
    Dim bmpfile_info As BITMAPFILEHEADER
    Dim lpBytesWritten As Long
    Picture1ScaleMode = vbPixels
    With bmp_infobmiHeader
        biSize = LenB(bmp_infobmiHeader)
        biWidth = Picture1ScaleWidth
        biHeight = Picture1ScaleHeight
        biPlanes = 1
        biBitCount = 24
        biCompression = BI_RGB
        biSizeImage = biHeight  (((biWidth  biBitCount + 31) And &HFFFFFFE0) \ 8)
    End With
    hmemDC = CreateCompatibleDC(Picture1hdc)
    hmemBMP = CreateDIBSection(Picture1hdc, bmp_info, DIB_RGB_COLORS, lpmemBits, 0, 0)
    SelectObject hmemDC, hmemBMP
    BitBlt hmemDC, 0, 0, bmp_infobmiHeaderbiWidth, bmp_infobmiHeaderbiHeight, Picture1hdc, 0, 0, vbSrcCopy
    '保存
    hFile = CreateFile(AppPath & "\testbmp", GENERIC_WRITE, 0, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
    If hFile <> INVALID_HANDLE_VALUE Then
        With bmpfile_info
            bfType = BITMAPTYPE
            bfOffBits = 14 + bmp_infobmiHeaderbiSize
            bfSize = bfOffBits + bmp_infobmiHeaderbiSizeImage
        End With
        WriteFile hFile, bmpfile_infobfType, 2, lpBytesWritten, 0
        WriteFile hFile, bmpfile_infobfSize, 12, lpBytesWritten, 0
        WriteFile hFile, bmp_infobmiHeader, bmp_infobmiHeaderbiSize, lpBytesWritten, 0
        WriteFile hFile, ByVal lpmemBits, bmp_infobmiHeaderbiSizeImage, lpBytesWritten, 0
        CloseHandle hFile
    End If
    DeleteObject hmemBMP
    DeleteDC hmemDC
End Sub

'添加Picture1，并将其autoredraw和autosize属性设置为true，然后添加个按钮，下面是代码
Private Sub Command1_Click()
    Picture1Picture = "d:\daisyjpg"
    PrinterOrientation = 2
    PrinterPaintPicture Picture1Image, 0, 0, Picture1Width, Picture1Height
    PrinterEndDoc
End Sub

给你个例子。
先剪贴到剪贴板中，在转成picture，再打印
Private Const HORZRES = 8 ' Horizontal width in pixels
Private Const VERTRES = 10 ' Vertical width in pixels
Private Const CF_BITMAP = 2
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Sub printPic(obj As Object, ByVal picWidth As Integer, ByVal picHeight As Integer)
Dim hScrDC As Long
hScrDC = GetDC(objhWnd)
Dim hMemDC As Long
hMemDC = CreateCompatibleDC(hScrDC)
Dim xScrn As Integer
Dim yScrn As Integer
objScaleMode = vbPixels ' 6-mm
xScrn = objScaleWidth '+ 200
yScrn = objScaleHeight '+ 200
Dim hBitmap As Long
hBitmap = CreateCompatibleBitmap(hScrDC, xScrn, yScrn)
Dim hOldmap As Long
hOldmap = SelectObject(hMemDC, hBitmap)
BitBlt hMemDC, 0, 0, xScrn, yScrn, hScrDC, 0, 0, SRCCOPY
hBitmap = SelectObject(hMemDC, hOldmap)
DeleteDC hScrDC
DeleteDC hMemDC
OpenClipboard hWnd
EmptyClipboard
SetClipboardData CF_BITMAP, hBitmap
CloseClipboard
Dim pictureX As Picture
Set pictureX = ClipboardgetData()
'PrinterPrint " "
PrinterScaleMode = 6
PrinterPaintPicture pictureX, 0, 0, picWidth, picHeight
PrinterNewPage
'PrinterEndDoc
Exit Sub
End Sub

创建个Picture1和Picture2。没什么实际用途、仅供加载用，不会影响你的程序。

Private Sub Command3_Click()
    Picture1AutoRedraw = True
    Picture2AutoRedraw = True
    Picture1Visible = False
    Picture2Visible = False
    Picture1Cls
    Picture2Cls
    BitBlt Picture1hDC, 0, 0, MeScaleWidth / ScreenTwipsPerPixelX, MeScaleHeight / ScreenTwipsPerPixelY, MehDC, 0, 0, vbSrcCopy
    '截图
    For X = 0 To Picture1ScaleWidth Step ScreenTwipsPerPixelX
        For Y = 0 To Picture1ScaleHeight Step ScreenTwipsPerPixelY
            Picture2PSet (Picture1ScaleHeight - Y, X), Picture1Point(X, Y)
        Next Y
    Next X
    '电脑是宽屏, A4纸是竖直插入的, 所以要旋转
    Picture2Picture = Picture2Image
    
    '打印
    PrinterPaintPicture Picture2Picture, 0, 0
    PrinterEndDoc
End Sub

建一个Picture1 我默认路径为D:\ajpg，请自己修改。
代码如下。
＝＝＝＝＝＝＝
Private Sub Form_Load()
Picture1Picture = LoadPicture("d:\ajpg")
MsgBox "高" & Picture1PictureHeight & "宽" & Picture1PictureWidth
End Sub

---