PrintForm OLE1.CreateLink giving Error Run-Time error '482' Printer error

Hi,
Ever since the Win 10.0.15063 update I am unable to print a form in my Visual Basic 6 program (it works fine under Win 10.0.14393), so I am putting off updating some computers that use this Visual Basic program until I find a fix.

I use the command "frmPrint1.PrintForm", but the program gives me the error message Run-time error '482' Printer error. I do have printers installed and they do work. If I issue the command "frmAbout.PrintForm" and another form then it will print.
I have narrowed down the problem to an "OLE1.CreateLink tmpFile" code in the frmPrint1 form. If I comment this line out, then the rest of the form will print (just without the OLE Excel object).

I have tried different possible solutions I have found on the Internet, but none of them work. Does anyone know of a possible solution to fix this?

Thank you for any help or suggestions.
Doug

have you tried setting a specific printer to be the application printer, rather than just using the default printer?

Quote:

---

Originally Posted by westconn1

have you tried setting a specific printer to be the application printer, rather than just using the default printer?

---

Yes, I have tried setting it to a specific printer (several different printers also), but that didn't fix the problem, I am still getting the error '482' Printer error.

Hi Eagle,

I'm currently running VB6-SP6 on Windows 10 Home Version 1703, OS Build 15063.674. This seems to be the same version you say you're having problems with.

I did some testing and seem to be getting the same error that you're getting.

Attachment 152739

I played around with the OLE control and figured out that it only errors when it contains something. It doesn't seem to matter what it contains (Excel, Word, WordPad, etc). Furthermore, it doesn't seem to matter whether the file is linked or embedded. Also, I was just "right-clicking / Insert Object..." to get things into the OLE control, rather than doing it from code. Again, if the OLE is empty, all works fine, however, if anything is in it (embedded or linked), you get the error.

Also, all the behavior seems to be the same regardless of whether you're executing in the IDE or compiled.

I've attached a little project so that others could test on different versions of Windows. It's just a little project with a Form1, Command1, and OLE1:

Attachment 152741

The OLE1 has a very small embedded WordPad file in it, which is enough to show the error. Just as an FYI, this embedded WordPad file will be saved by stuffing it into the Form1.frx, so you'll get it in the attached project.

Here's the code I've got in Form1:

Code:

---


Option Explicit

Private Sub Command1_Click()
    Me.PrintForm
End Sub


---

I'll be curious as to what Windows OSs this runs on and which it fails on.

I'm guessing that the OLE control is trying to get too fancy when the PrintForm is executed. As a possible work-around, you might execute some code that captures your form to the clipboard, and then print that image. I don't have code handy that does that, but I'm confident that I could work that out.

Good Luck,
Elroy


EDIT1: I googled around a bit, and this seems like it might get you there if you decide to go with my suggested work-around.

EDIT2: Actually, if you study that code a bit, you'll see that you can just print the PictureBox and stay away from the Clipboard entirely, and accomplish what you need.

EDIT3: Interesting, I tried the following code (with a Picture1 control added to the above Form1)...

Code:

---


Option Explicit
'
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'
Private Const WM_PAINT = &HF
Private Const WM_PRINT = &H317
Private Const PRF_CLIENT = &H4&    ' Draw the window's client area
Private Const PRF_CHILDREN = &H10& ' Draw all visible child
Private Const PRF_OWNED = &H20&    ' Draw all owned windows

Private Sub Command1_Click()
    Dim ret As Long
    '
    Picture1.Width = Me.Width
    Picture1.Height = Me.Height
    Picture1.AutoRedraw = True
    '
    ret = SendMessage(Me.hwnd, WM_PAINT, Picture1.hDC, 0)
    ret = SendMessage(Me.hwnd, WM_PRINT, Picture1.hDC, PRF_CHILDREN + PRF_CLIENT + PRF_OWNED)
    '
    Set Picture1.Picture = Picture1.Image
    Printer.PaintPicture Picture1.Picture, 0, 0
End Sub


---

... and I don't get an error. The form prints, but the OLE control prints blank, even though it's clearly not. I looked at what was captured in the Picture1. You could see the OLE1, but the "asdf" text was gone. So, back to the drawing board.

EDIT4: There's clearly a way to do this because it works when I do Alt-PrintScreen and then paste to Paint.

Alright, I kept at it, and the following code seems to get it done. Again, I just added a PictureBox to the project attached to post #4. Also, it seems that you could do away with the PictureBox and just directly print the return of GetSnapshot. Just as an FYI, I borrowed code from here to get this going.

Code:

---


Option Explicit
'
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
'
Private Type PICTDESC
    cbSize As Long
    pictType As Long
    hIcon As Long
    hPal As Long
End Type
'
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (lpPictDesc As PICTDESC, riid As Any, ByVal fOwn As Long, ipic As IPicture) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC 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 hDCDest As Long, ByVal XDest As Long, ByVal YDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal lScreenDC 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 GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
'

Private Sub Command1_Click()
    Dim pic As IPictureDisp
    '
    Picture1.Width = Me.Width
    Picture1.Height = Me.Height
    Picture1.AutoRedraw = True
    '
    Set pic = GetSnapshot(Me.hWnd)
    Set Picture1.Picture = pic
    '

    'SavePicture Picture1.Picture, "c:\users\elroy\desktop\temp.bmp"
    '
    Printer.PaintPicture Picture1.Picture, 0, 0
End Sub

Function GetSnapshot(ByVal hWnd As Long) As IPictureDisp
    Dim targetDC As Long
    Dim hDC As Long
    Dim tempPict As Long
    Dim oldPict As Long
    Dim wndWidth As Long
    Dim wndHeight As Long
    Dim pic As PICTDESC
    Dim rcWindow As RECT
    Dim guid(3) As Long
    '
    ' provide the right handle for the desktop window
    If hWnd = 0 Then hWnd = GetDesktopWindow
    '
    ' get window's size
    GetWindowRect hWnd, rcWindow
    wndWidth = rcWindow.Right - rcWindow.Left
    wndHeight = rcWindow.Bottom - rcWindow.Top
    ' get window's device context
    targetDC = GetWindowDC(hWnd)
    '
    ' create a compatible DC
    hDC = CreateCompatibleDC(targetDC)
    '
    ' create a memory bitmap in the DC just created
    ' the has the size of the window we're capturing
    tempPict = CreateCompatibleBitmap(targetDC, wndWidth, wndHeight)
    oldPict = SelectObject(hDC, tempPict)
    '
    ' copy the screen image into the DC
    BitBlt hDC, 0, 0, wndWidth, wndHeight, targetDC, 0, 0, vbSrcCopy
    '
    ' set the old DC image and release the DC
    tempPict = SelectObject(hDC, oldPict)
    DeleteDC hDC
    ReleaseDC GetDesktopWindow, targetDC
    '
    ' fill the ScreenPic structure
    With pic
        .cbSize = Len(pic)
        .pictType = 1          ' means picture
        .hIcon = tempPict
        .hPal = 0          ' (you can omit this of course)
    End With
    '
    ' convert the image to a IpictureDisp object
    ' this is the IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
    ' we use an array of Long to initialize it faster
    guid(0) = &H7BF80980
    guid(1) = &H101ABF32
    guid(2) = &HAA00BB8B
    guid(3) = &HAB0C3000
    '
    ' create the picture,
    ' return an object reference right into the function result
    OleCreatePictureIndirect pic, guid(0), True, GetSnapshot
End Function


---

Now, I'm not sure why, but that GetSnapshot function seems to grab a couple of extra pixels on the Left, Right, & Bottom. Maybe that's part of the non-client area, the part that Windows 10 uses for fading. I'm not sure. Here's a capture of what's actually printed. You can see the extra pixels.

Attachment 152745

I'd be a touch nervous about cropping those pixels, as then, it may work differently on older versions of Windows.

Good Luck,
Elroy

I'd be a touch nervous about cropping those pixels, as then, it may work differently on older versions of Windows.

Good Luck,
Elroy[/QUOTE]
---
Elroy,
I will try some of your suggestions.
You know, I am able to get only the OLE to print using the command: OLE1.ActiveSheet.PrintOut Copies:=1, Collate:=True
and I can get the Form to print if I comment out my code: OLE1.CreateLink tmpFile
I wish there was a way to put the two together to print on the same page.
Thanks,
Doug

Well, now I see you've got an Excel file loaded into your OLE control. With your OLE1.ActiveSheet.PrintOut statement, you're effectively using Excel automation (and the Excel VBA) to print your worksheet. That's basically outside the control of VB6, and handing the printing task to the Excel program (which is loaded into memory when you do this).

Under most circumstances when you use PrintForm, I wouldn't think all that is happening. But clearly, something has changed with the latest version of Windows 10.

If you'd care to show us, I'd be curious as to what all is on this form you're trying to print. Basically, a screen-shot posted here would be nice. Personally, I don't think I've ever used PrintForm for any production code. IMHO, it's just much better to format our own reports and print those. However, I know that everyone has their own way of doing things.

Take Care,
Elroy

[QUOTE=Elroy;5223739]Well, now I see you've got an Excel file loaded into your OLE control. With your OLE1.ActiveSheet.PrintOut statement, you're effectively using Excel automation (and the Excel VBA) to print your worksheet. That's basically outside the control of VB6, and handing the printing task to the Excel program (which is loaded into memory when you do this).

Under most circumstances when you use PrintForm, I wouldn't think all that is happening. But clearly, something has changed with the latest version of Windows 10.

If you'd care to show us, I'd be curious as to what all is on this form you're trying to print. Basically, a screen-shot posted here would be nice. Personally, I don't think I've ever used PrintForm for any production code. IMHO, it's just much better to format our own reports and print those. However, I know that everyone has their own way of doing things.

Take Care,
Elroy

---
Attachment 152759

Elroy,
Attached is the sample Form, I removed the page letterhead and footer information.
On my entry screen, we enter the data, and select an Excel file with the material specs we are providing a Submittal for
then when we go to print the form it takes the data from the fields, and replaces the OLE1 object with the Excel specs information, then prints.
I have not really seen an easier way to print a form like this then to use the .PrintForm option, I had seen some code where they loop through the items on a form and try to print it that way, but I didn't get that to work for me.
I would like to upgrade this application to Visual Basic 2017, but I have not seen the same type OLE1 option, maybe they handle this a different way now.
Doug

Elroy,
I don't actually use the OLE1.ActiveSheet.PrintOut statement, I just found this as a way to see if the OLE1 object would print, and it did using this.
In all previous version of Windows 98,XP,Vista,8,10.0.14393 I have been able to just use the .PrintForm option and it would print my form. Just trying to figure out what is different with it now, so I can fix it. Thanks.

Hmmm, well, if it were me, I'd tend to build an Excel worksheet that looked just like I wanted, and then print that (probably using Excel automation from VB6).

But this does seem like a well developed piece of software. I believe that takes you back to the ideas in my post #5. You may still have to work on those extra couple of pixels, but maybe with a borderless form, those problems will go away. With not much work, I'm relatively confident I could get it going. Worst case, you may have to check the Windows version to decide how to handle those extra few border pixels.

Good Luck,
Elroy

And, if you wind up needing the Windows version, here's a function to do that. It does use the winmgmts object, but it's not dependent on any API calls. Also, it circumvents any shims (compatibility options) you may have set for the executable.

Code:

---


Public Function WindowsVersion() As Long
    '
    ' This is independent of any manifest or any compatibility settings.
    '
    '    OS              WindowsVersion return
    ' Windows 10                100
    ' Windows 8.1                63
    ' Windows 8.0                62
    ' Windows 7                  61
    ' Windows Vista              60
    ' Windows XP                51
    ' Windows 2000              50
    '                            -1 failed.
    Static lVersion As Long
    Dim SystemSet As Object
    Dim System As Object
    Dim s As String
    Dim i As Long
    '
    If lVersion Then
        WindowsVersion = lVersion
        Exit Function
    End If
    '
    On Error Resume Next
        Set SystemSet = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
        For Each System In SystemSet: s = System.Version: Next
        '
        i = InStr(s, ".")
        s = Left$(s, i - 1) & mid$(s, i + 1)
        i = InStr(s, ".")
        If i Then s = Left$(s, i - 1)
        lVersion = val(s)
        WindowsVersion = lVersion
    On Error GoTo 0
End Function



---