2-х сторонняя печать через Win32 API

[KVG]

На форуме VBA мне ничего не ответили, поэтому попробую выяснить на основном форуме - помогите из VBA распечатать листы Excel 2-ух_сторонней печатью (без вызова диалог. окон). Объекта Printer в VBA нет. Т.е. действуем путём установки параметра dmDuplex структуры DEVMODE перед печатью страниц каждого листа. Принтер сетевой. Для этого продекларировал функции: DocumentProperties, GetProfileString, OpenPrinter, GetPrinter, SetPrinter, CreateDC, StartDoc, StartPage, CopyMemory, IsBadStringPtrByLong и их структуры: DRIVER_INFO_2, DOCINFO, PRINTER_DEFAULTS, PRINTER_INFO_2, DEVMODE
Вот "набросок" кода, но как его завершить?:

Код: Выделить всё

Sub PrintDuplex()

Dim sBuffer As String, sPrinterName As String, sPrinterPort As String
Dim sDriverName As String, sFullFileName  As String
Dim pd As PRINTER_DEFAULTS
Dim pi2 As PRINTER_INFO_2
Dim di2 As DRIVER_INFO_2
Dim dm As DEVMODE
Dim doc_i As DOCINFO
Dim Buffer() As Long
Dim lNeeded As Long, lReturned As Long
Dim hPrinter As Long, nRet As Long, hPrintDC As Long
Dim i As Integer, rbuffer As Integer

Const PRINTER_ACCESS_ADMINISTER = &H4
Const PRINTER_ACCESS_USE = &H8
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const PRINTER_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE
Const DM_IN_BUFFER = 8
Const DM_OUT_BUFFER = 2
Const DM_DUPLEX = &H1000&

    sBuffer = String(128, 0)
    nRet = GetProfileString("windows", "Device", "", sBuffer, Len(sBuffer))
    sBuffer = Mid(sBuffer, 1, nRet)
    sPrinterName = Mid(sBuffer, 1, InStr(sBuffer, ",") - 1)
    sPrinterPort = Mid(sBuffer, InStrRev(sBuffer, ",") + 1)

'*** Open printer with all access to be able to modify settings
    pd.DesiredAccess = PRINTER_ALL_ACCESS
    nRet = OpenPrinter(sPrinterName, hPrinter, pd) 'дескриптор принтера- hPrinter

'*** 1) получаем размер структуры DEVMODE
    nRet = DocumentProperties(0, hPrinter, sPrinterName, 0, 0, 0)
    ReDim Buffer(nRet + 100) As Long
'*** 2) получаем текущ. настройки принтера - заполняем буфер инф-цией из DEVMODE
    nRet = DocumentProperties(0, hPrinter, sPrinterName, Buffer(0), 0, DM_OUT_BUFFER)
    CopyMemory dm, Buffer(0), Len(dm)
'*** 3) заменяем настройки принтера
     dm.dmFields = DM_DUPLEX
     dm.dmOrientation = 2
     dm.dmDuplex = 2
'*** 4) запоминаем новые настройки принтера
    CopyMemory Buffer(0), dm, Len(dm)
    nRet = DocumentProperties(0, hPrinter, sPrinterName, Buffer(0), Buffer(0), DM_IN_BUFFER Or DM_OUT_BUFFER)
'*** 5) проверяем новые настройки принтера
    CopyMemory dm, Buffer(0), Len(dm)
    b16 = dm.dmDuplex

'****** узнаем нужный размер для буфера для структуры PRINTER_INFO_2
    nRet = GetPrinter(hPrinter, 2, 0, 0, lNeeded)
    rbuffer = (lNeeded / 4) + 3
    ReDim Buffer(0 To rbuffer) As Long
'****** заполняем буфер информацией из структуры PRINTER_INFO_2
    nRet = GetPrinter(hPrinter, 2, Buffer(0), rbuffer * 4, lReturned)
    sDriverName = LPSTRtoBSTR(Buffer(4))
    CopyMemory pi2, Buffer(0), Len(pi2)

'****** передаём в структуру PRINTER_INFO_2 указатель на DEVMODE
    pi2.pDevmode = VarPtr(dm)
    CopyMemory Buffer(0), pi2, Len(pi2)
    nRet = SetPrinter(hPrinter, 2, Buffer(0), 0)
   
    sFullFileName = ActiveWorkbook.FullName
'****** Load information about the document to print into the structure.
    doc_i.cbSize = Len(doc_i)  ' size of structure
    doc_i.lpszDocName = sFullFileName ' sFullFileName не помогло
    doc_i.lpszOutput = 0       ' do not print to a file
    doc_i.lpszDatatype = ""    ' data type of file doesn't apply
    doc_i.fwType = 0           ' no additional information

'****** передадим конечный DEVMODE контексту принтера CreateDC ???
    hPrintDC = CreateDC(sDriverName, sPrinterName, sPrinterPort, dm)

'****** печатаем Я идиот! Убейте меня, кто-нибудь!
    nRet = StartDoc(hPrintDC, doc_i)
    nRet = StartPage(hPrintDC)
    DoEvents
    nRet = EndPage(hPrintDC)
    nRet = EndDoc(hPrintDC)
   
    ClosePrinter (hPrinter)
    DeleteDC hPrintDC

End Sub
   
Public Function LPSTRtoBSTR(ByVal lpsz As Long) As String
Dim sString As String, plMaxLen As Long
   
If lpsz <> 0 Then
    plMaxLen = lstrlen(lpsz)
    If Not IsBadStringPtrByLong(lpsz, plMaxLen) Then
        sString = String$(plMaxLen, 0)
        CopyMemory ByVal StrPtr(sString), ByVal lpsz, plMaxLen
        If Err.LastDllError = 0 Then
            If InStr(sString, Chr$(0)) > 0 Then
                sString = Trim(StrConv(sString, vbUnicode))
                LPSTRtoBSTR = Left$(sString, InStr(sString, Chr$(0)) - 1)
            Else
                LPSTRtoBSTR = IIf(lpsz < 10000, "Значение: " & lpsz, "Указатель: " & lpsz)
            End If
        End If
    Else
        LPSTRtoBSTR = "Указатель: " & lpsz
    End If
Else
    LPSTRtoBSTR = "Указатель: " & lpsz
End If

End Function

Так же возник теоритический вопрос: структура DEVMODE "существует" в DocumentProperties, также на неё есть указатель в PRINTER_INFO_2. Т.е. сама структура принадлежит только документу и указатель на неё перед печатью нужно дать принтеру? Но возможность 2-х сторонней печати - определяется принтером и его драйвером...Если бы заглянуть в исходные коды Била.