http://support.microsoft.com/support/kb/articles/q282/4/74.asp

Module1.bas  
  Option   Explicit  
  Public   Enum   PrinterOrientationConstants  
          OrientPortrait   =   1  
          OrientLandscape   =   2  
  End   Enum  
  Private   Type   DEVMODE  
          dmDeviceName   As   String   *   32  
          dmSpecVersion   As   Integer  
          dmDriverVersion   As   Integer  
          dmSize   As   Integer  
          dmDriverExtra   As   Integer  
          dmFields   As   Long  
          dmOrientation   As   Integer  
          dmPaperSize   As   Integer  
          dmPaperLength   As   Integer  
          dmPaperWidth   As   Integer  
          dmScale   As   Integer  
          dmCopies   As   Integer  
          dmDefaultSource   As   Integer  
          dmPrintQuality   As   Integer  
          dmColor   As   Integer  
          dmDuplex   As   Integer  
          dmYResolution   As   Integer  
          dmTTOption   As   Integer  
          dmCollate   As   Integer  
          dmFormName   As   String   *   32  
          dmUnusedPadding   As   Integer  
          dmBitsPerPel   As   Integer  
          dmPelsWidth   As   Long  
          dmPelsHeight   As   Long  
          dmDisplayFlags   As   Long  
          dmDisplayFrequency   As   Long  
  End   Type  
  Private   Type   PRINTER_DEFAULTS  
          pDataType   As   String  
          pDevMode   As   Long  
          DesiredAccess   As   Long  
  End   Type  
  Private   Type   PRINTER_INFO_2  
          pServerName   As   Long  
          pPrinterName   As   Long  
          pShareName   As   Long  
          pPortName   As   Long  
          pDriverName   As   Long  
          pComment   As   Long  
          pLocation   As   Long  
          pDevMode   As   Long  
          pSepFile   As   Long  
          pPrintProcessor   As   Long  
          pDataType   As   Long  
          pParameters   As   Long  
          pSecurityDescriptor   As   Long  
          Attributes   As   Long  
          Priority   As   Long  
          DefaultPriority   As   Long  
          StartTime   As   Long  
          UntilTime   As   Long  
          Status   As   Long  
          cJobs   As   Long  
          AveragePPM   As   Long  
  End   Type  
   
  Private   Const   DM_IN_BUFFER   As   Long   =   8  
  Private   Const   DM_OUT_BUFFER   As   Long   =   2  
  Private   Const   DM_ORIENTATION   As   Long   =   &H1  
  Private   Const   DM_PAPERLENGTH   As   Long   =   &H4  
  Private   Const   DM_PAPERWIDTH   As   Long   =   &H8  
   
  Private   Const   PRINTER_ACCESS_ADMINISTER   As   Long   =   &H4  
  Private   Const   PRINTER_ACCESS_USE   As   Long   =   &H8  
  Private   Const   STANDARD_RIGHTS_REQUIRED   As   Long   =   &HF0000  
  Private   Const   PRINTER_ALL_ACCESS   =   (STANDARD_RIGHTS_REQUIRED   Or   PRINTER_ACCESS_ADMINISTER   Or   PRINTER_ACCESS_USE)  
   
  Private   Declare   Sub   CopyMemory   Lib   "kernel32"   Alias   "RtlMoveMemory"   (hpvDest   As   Any,   hpvSource   As   Any,   ByVal   cbCopy   As   Long)  
  Private   Declare   Function   OpenPrinter   Lib   "winspool.drv"   Alias   "OpenPrinterA"   (ByVal   pPrinterName   As   String,   phPrinter   As   Long,   pDefault   As   Any)   As   Long  
  Private   Declare   Function   ClosePrinter   Lib   "winspool.drv"   (ByVal   hPrinter   As   Long)   As   Long  
  Private   Declare   Function   DocumentProperties   Lib   "winspool.drv"   Alias   "DocumentPropertiesA"   (ByVal   hWnd   As   Long,   ByVal   hPrinter   As   Long,   ByVal   pDeviceName   As   String,   pDevModeOutput   As   Any,   pDevModeInput   As   Any,   ByVal   fMode   As   Long)   As   Long  
  Private   Declare   Function   GetPrinter   Lib   "winspool.drv"   Alias   "GetPrinterA"   (ByVal   hPrinter   As   Long,   ByVal   Level   As   Long,   pPrinter   As   Any,   ByVal   cbBuf   As   Long,   pcbNeeded   As   Long)   As   Long  
  Private   Declare   Function   SetPrinter   Lib   "winspool.drv"   Alias   "SetPrinterA"   (ByVal   hPrinter   As   Long,   ByVal   Level   As   Long,   pPrinter   As   Any,   ByVal   Command   As   Long)   As   Long  
   
  Public   Function   SetDefaultPrinterSettings(   _  
          ByVal   eOrientation   As   PrinterOrientationConstants,   _  
          ByVal   pHeight   As   Integer,   _  
          ByVal   pWidth   As   Integer)   As   Boolean  
   
          Dim   bDevMode()   As   Byte  
          Dim   bPrinterInfo2()   As   Byte  
          Dim   hPrinter   As   Long  
          Dim   nSize   As   Long  
          Dim   sPrnName   As   String  
          Dim   dm   As   DEVMODE  
          Dim   pd   As   PRINTER_DEFAULTS  
          Dim   pi2   As   PRINTER_INFO_2  
           
          '   Get   device   name   of   default   printer  
          sPrnName   =   Printer.DeviceName  
          '   PRINTER_ALL_ACCESS   required   under  
          '   NT,   because   we're   going   to   call   SetPrinter  
          pd.DesiredAccess   =   PRINTER_ALL_ACCESS  
          '   Get   a   handle   to   the   printer.  
          If   OpenPrinter(sPrnName,   hPrinter,   pd)   Then  
                  '   Get   number   of   bytes   requires  
                  '   for   PRINTER_INFO_2   structure  
                  Call   GetPrinter(hPrinter,   2&,   0&,   0&,   nSize)  
                  '   Create   a   buffer   of   the   required   size  
                  ReDim   bPrinterInfo2(1   To   nSize)   As   Byte  
                  '   Fill   buffer   with   structure  
                  Call   GetPrinter(hPrinter,   2,   bPrinterInfo2(1),   nSize,   nSize)  
                  '   Copy   fixed   portion   of   structure   into  
                  '   VB   Type   variable  
                  Call   CopyMemory(pi2,   bPrinterInfo2(1),   Len(pi2))  
                  '   Get   number   of   bytes   requires  
                  '   for   DEVMODE   structure  
                  nSize   =   DocumentProperties(0&,   hPrinter,   sPrnName,   0&,   0&,   0)  
                  '   Create   a   buffer   of   the   required   size  
                  ReDim   bDevMode(1   To   nSize)  
                  '   If   PRINTER_INFO_2   points   to   a  
                  '   DEVMODE   structure,   copy   it   into   our   buffer  
                  If   pi2.pDevMode   Then  
                          Call   CopyMemory(bDevMode(1),   ByVal   pi2.pDevMode,   Len(dm))  
                  Else  
                          '   Otherwise,   call   DocumentProperties   to  
                          '   get   a   DEVMODE   structure  
                          Call   DocumentProperties(0&,   hPrinter,   sPrnName,   bDevMode(1),   0&,   DM_OUT_BUFFER)  
                  End   If  
                  '   Copy   fixed   portion   of   structure  
                  '   into   VB   Type   variable  
                  Call   CopyMemory(dm,   bDevMode(1),   Len(dm))  
                  With   dm  
                          '   Write   the   settings  
                          .dmFields   =   .dmFields   Or   DM_ORIENTATION  
                          .dmOrientation   =   eOrientation  
                          .dmFields   =   .dmFields   Or   DM_PAPERWIDTH  
                          .dmPaperWidth   =   pWidth  
                          .dmFields   =   .dmFields   Or   DM_PAPERLENGTH  
                          .dmPaperLength   =   pHeight  
                  End   With  
                  '   Copy   our   Type   back   into   buffer  
                  Call   CopyMemory(bDevMode(1),   dm,   Len(dm))  
                  '   Write   the   settings  
                  Call   DocumentProperties(0&,   hPrinter,   sPrnName,   bDevMode(1),   bDevMode(1),   DM_IN_BUFFER   Or   DM_OUT_BUFFER)  
                  '   Point   PRINTER_INFO_2   at   our   modified   DEVMODE  
                  pi2.pDevMode   =   VarPtr(bDevMode(1))  
                  '   Set   new   orientation   system-wide  
                  Call   SetPrinter(hPrinter,   2,   pi2,   0&)  
                  '   Clean   up   and   exit  
                  Call   ClosePrinter(hPrinter)  
                  SetDefaultPrinterSettings   =   True  
          Else  
                  SetDefaultPrinterSettings   =   False  
          End   If  
           
          MsgBox   (dm.dmPaperLength)  
  End   Function  
   
  *****************************************************  
  Private   Sub   Command1_Click()  
  '长   150mm,宽   100   mm  
          Call   SetDefaultPrinterSettings(OrientPortrait,   1500,   1000)          
  End   Sub