Private Sub Command1_Click()\n    \'установить 200х200\n    Dim OldQuality As String\n    Dim errm As String\n    MsgBox SetGetPrinterQuality(OldQuality, "MyPrinter", "200x200", True, errm)\nEnd Sub\n\nPrivate Sub Command2_Click()\n    \'установить 200х100\n    Dim OldQuality As String\n    Dim errm As String\n    MsgBox SetGetPrinterQuality(OldQuality, "MyPrinter", "200x100", True, errm)\n End Sub\n\nPrivate Sub Command3_Click()\n    \'посмотреть, чего установлено\n    Dim OldQuality As String\n    SetGetPrinterQuality OldQuality, "MyPrinter"\n    MsgBox OldQuality\nEnd Sub\n\n\nOption Explicit\n\n      Public Const NULLPTR =  0 &\n      \' Constants for DEVMODE\n      Public Const CCHDEVICENAME =  32 \n      Public Const CCHFORMNAME =  32 \n      \' Constants for DocumentProperties\n      Public Const DM_MODIFY =  8 \n      Public Const DM_COPY =  2 \n      Public Const DM_IN_BUFFER = DM_MODIFY\n      Public Const DM_OUT_BUFFER = DM_COPY\n      \' Constants for dmOrientation\n      Public Const DMORIENT_PORTRAIT =  1 \n      Public Const DMORIENT_LANDSCAPE =  2 \n      \' Constants for dmPrintQuality\n      Public Const DMRES_DRAFT = (- 1 )\n      Public Const DMRES_HIGH = (- 4 )\n      Public Const DMRES_LOW = (- 2 )\n      Public Const DMRES_MEDIUM = (- 3 )\n      \' Constants for dmTTOption\n      Public Const DMTT_BITMAP =  1 \n      Public Const DMTT_DOWNLOAD =  2 \n      Public Const DMTT_DOWNLOAD_OUTLINE =  4 \n      Public Const DMTT_SUBDEV =  3 \n      \' Constants for dmColor\n      Public Const DMCOLOR_COLOR =  2 \n      Public Const DMCOLOR_MONOCHROME =  1 \n      \' Constants for dmCollate\n      Public Const DMCOLLATE_FALSE =  0 \n      Public Const DMCOLLATE_TRUE =  1 \n      Public Const DM_COLLATE As Long = &H8000\n      \' Constants for dmDuplex\n      Public Const DM_DUPLEX = &H1000&\n      Public Const DMDUP_HORIZONTAL =  3 \n      Public Const DMDUP_SIMPLEX =  1 \n      Public Const DMDUP_VERTICAL =  2 \n      \n   Public Type PRINTER_DEFAULTS\n       pDatatype As Long\n       pDevmode As Long\n       DesiredAccess As Long\n   End Type\n\n   Public Type PRINTER_INFO_2\n       pServerName As Long\n       pPrinterName As Long\n       pShareName As Long\n       pPortName As Long\n       pDriverName As Long\n       pComment As Long\n       pLocation As Long\n       pDevmode As Long       \' Pointer to DEVMODE\n       pSepFile As Long\n       pPrintProcessor As Long\n       pDatatype As Long\n       pParameters As Long\n       pSecurityDescriptor As Long  \' Pointer to SECURITY_DESCRIPTOR\n       Attributes As Long\n\n\n       Priority As Long\n       DefaultPriority As Long\n       StartTime As Long\n       UntilTime As Long\n       Status As Long\n       cJobs As Long\n       AveragePPM As Long\n   End Type\n\n   Public Type DEVMODE\n       dmDeviceName As String *  32 \n\n       dmSpecVersion As Integer\n       dmDriverVersion As Integer\n       dmSize As Integer\n       dmDriverExtra As Integer\n       dmFields As Long\n       dmOrientation As Integer\n       dmPaperSize As Integer\n       dmPaperLength As Integer\n       dmPaperWidth As Integer\n       dmScale As Integer\n       dmCopies As Integer\n       dmDefaultSource As Integer\n       dmPrintQuality As Integer\n       dmColor As Integer\n       dmDuplex As Integer\n       dmYResolution As Integer\n       dmTTOption As Integer\n       dmCollate As Integer\n       dmFormName As String *  32 \n       dmUnusedPadding As Integer\n       dmBitsPerPel As Integer\n       dmPelsWidth As Long\n       dmPelsHeight As Long\n       dmDisplayFlags As Long\n       dmDisplayFrequency As Long\n       dmICMMethod As Long\n       dmICMIntent As Long\n       dmMediaType As Long\n       dmDitherType As Long\n       dmReserved1 As Long\n       dmReserved2 As Long\n   End Type\n\n   Public Type PRINTER_INFO_9\n       pDevmode As Long       \' Pointer to DEVMODE\n   End Type\n   \n   Public Const PRINTER_ACCESS_ADMINISTER = &H4\n   Public Const PRINTER_ACCESS_USE = &H8\n   Public Const STANDARD_RIGHTS_REQUIRED = &HF0000\n   Public Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _\n             PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)\n\n   Public Declare Function ClosePrinter Lib "winspool.drv" _\n    (ByVal hPrinter As Long) As Long\n   Public Declare Function DocumentProperties Lib "winspool.drv" _\n     Alias "DocumentPropertiesA" (ByVal hwnd As Long, _\n     ByVal hPrinter As Long, ByVal pDeviceName As String, _\n     ByVal pDevModeOutput As Long, ByVal pDevModeInput As Long, _\n     ByVal fMode As Long) As Long\n   Public Declare Function GetPrinter Lib "winspool.drv" Alias _\n     "GetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _\n     pPrinter As Byte, ByVal cbBuf As Long, pcbNeeded As Long) As Long\n   Public Declare Function OpenPrinter Lib "winspool.drv" Alias _\n     "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, _\n     pDefault As PRINTER_DEFAULTS) As Long\n   Public Declare Function SetPrinter Lib "winspool.drv" Alias _\n     "SetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _\n     pPrinter As Byte, ByVal Command As Long) As Long\n\n   Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _\n    (pDest As Any, pSource As Any, ByVal cbLength As Long)\n    \nPublic Declare Function GetLastError Lib "kernel32" () As Long\n\n   Public Function SetGetPrinterQuality(ByRef lPrevQuality As String, _\n       Optional sPrinterName As String, _\n       Optional nNewQuality As String, _\n       Optional bSet As Boolean, _\n       Optional sErrMsg As String) As Boolean\n\n      Dim hPrinter As Long\n      Dim pd As PRINTER_DEFAULTS\n      Dim pinfo As PRINTER_INFO_9\n      Dim dm As DEVMODE\n\n      Dim yDevModeData() As Byte\n      Dim yPInfoMemory() As Byte\n      Dim nBytesNeeded As Long\n      Dim nRet As Long, nJunk As Long\n      Dim iFirstRight As Integer\n      Dim i As Integer\n\n      On Error GoTo cleanup\n\n      \'pd.DesiredAccess = PRINTER_ACCESS_USE\n      pd.DesiredAccess = PRINTER_ALL_ACCESS\n      sPrinterName = sPrinterName & Chr( 0 )\n      nRet = OpenPrinter(sPrinterName, hPrinter, pd)\n      If (nRet =  0 ) Or (hPrinter =  0 ) Then\n         If Err.LastDllError =  5  Then\n            sErrMsg = "Access denied -- See the article for more info."\n         Else\n            sErrMsg = "Cannot open the printer specified " & _\n              "(make sure the printer name is correct)."\n         End If\n         Exit Function\n      End If\n\n      nRet = DocumentProperties( 0 , hPrinter, sPrinterName,  0 ,  0 ,  0 )\n      If (nRet <  0 ) Then\n         sErrMsg = "Cannot get the size of the DEVMODE structure."\n         GoTo cleanup\n      End If\n\n      ReDim yDevModeData(nRet +  100 ) As Byte\n      nRet = DocumentProperties( 0 , hPrinter, sPrinterName, _\n                  VarPtr(yDevModeData( 0 )),  0 , DM_OUT_BUFFER)\n      If (nRet <  0 ) Then\n         sErrMsg = "Cannot get the DEVMODE structure."\n         GoTo cleanup\n      End If\n\n      Call CopyMemory(dm, yDevModeData( 0 ), Len(dm))\n\n      lPrevQuality = dm.dmPrintQuality & "x" & dm.dmYResolution\n      \n      If Not bSet Then\n         GoTo cleanup\n      End If\n      Select Case nNewQuality\n            Case "200x200":\n                dm.dmPrintQuality =  200 \n                dm.dmYResolution =  200 \n            Case "200x100":\n                dm.dmPrintQuality =  200 \n                dm.dmYResolution =  100 \n            Case Else\n                GoTo cleanup\n      End Select\n      Call CopyMemory(yDevModeData( 0 ), dm, Len(dm))\n\n      nRet = DocumentProperties( 0 , hPrinter, sPrinterName, _\n        VarPtr(yDevModeData( 0 )), VarPtr(yDevModeData( 0 )), _\n        DM_IN_BUFFER Or DM_OUT_BUFFER)\n\n      If (nRet <  0 ) Then\n        sErrMsg = "Unable to set PrintQuality setting to this printer."\n        GoTo cleanup\n      End If\n\n      Call GetPrinter(hPrinter,  9 ,  0 ,  0 , nBytesNeeded)\n      If (nBytesNeeded =  0 ) Then GoTo cleanup\n\n      ReDim yPInfoMemory(nBytesNeeded +  100 ) As Byte\n\n      nRet = GetPrinter(hPrinter,  9 , yPInfoMemory( 0 ), nBytesNeeded, nJunk)\n      If (nRet =  0 ) Then\n         sErrMsg = "Unable to get shared printer settings."\n         GoTo cleanup\n      End If\n\n      Call CopyMemory(pinfo, yPInfoMemory( 0 ), Len(pinfo))\n      pinfo.pDevmode = VarPtr(yDevModeData( 0 ))\n      Call CopyMemory(yPInfoMemory( 0 ), pinfo, Len(pinfo))\n\n      nRet = SetPrinter(hPrinter,  9 , yPInfoMemory( 0 ),  0 )\n      If (nRet =  0 ) Then\n         sErrMsg = "Unable to set shared printer settings. " & GetLastError\n      End If\n\n\n      SetGetPrinterQuality = CBool(nRet)\n\ncleanup:\n      If (hPrinter <>  0 ) Then Call ClosePrinter(hPrinter)\n\n   End Function

rundll32 printui.dll,PrintUIEntry /Ss /n "MyPrinter" /a "c:\file.dat"  9 

rundll32 printui.dll,PrintUIEntry /Sr /n "MyPrinter" /a "c:\file.dat"

   ShellAndContinue "reg.exe import " & Chr( 34 ) & InstallPath & "printer.reg" & Chr( 34 ), vbHide

HKEY_CURRENT_USER\Printers\DevModePerUser\printer