注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

零售创新,创新那些事儿,SPSS,VBA

零售创新

 
 
 

日志

 
 
关于我

新浪微博,零售创新 研究经理,数据分析师 希望和市场研究和零售业的同事共同进步! 本博客发表的都是免费或试用的资料,如果有版权问题请发邮件wangli12a@163.com联系删除。 spss excel vba blog

网易考拉推荐

设置打印机设置为横向或者纵向打印  

2007-07-05 11:36:08|  分类: VB和VBA知识 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
设置打印机设置为横向或者纵向打印


'将打印设置为横向打印:ChngPrinterOrientationLandscape Me
'将打印设置为纵向打印:ChngPrinterOrientationPortrait Me
'将下面的文件存为.BAS文件,在打印窗体加载的时候按上面的方法调用即可

'Constants   used   in   the   DevMode   structure
  Private Const CCHDEVICENAME = 32
  Private Const CCHFORMNAME = 32
   
  'Constants   for   NT   security
  Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
  Private Const PRINTER_ACCESS_ADMINISTER = &H4
  Private Const PRINTER_ACCESS_USE = &H8
  Private Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or PRINTER_ACCESS_ADMINISTER Or

PRINTER_ACCESS_USE)
  
  'Constants   used   to   make   changes   to   the   values   contained   in   the   DevMode
  Private Const DM_MODIFY = 8
  Private Const DM_IN_BUFFER = DM_MODIFY
  Private Const DM_COPY = 2
  Private Const DM_OUT_BUFFER = DM_COPY
  Private Const DM_DUPLEX = &H1000&
  Private Const DMDUP_SIMPLEX = 1
  Private Const DMDUP_VERTICAL = 2
  Private Const DMDUP_HORIZONTAL = 3
  Private Const DM_ORIENTATION = &H1&
  Private PageDirection     As Integer
  '------USER   DEFINED   TYPES
  
  'The   DevMode   structure   contains   printing   parameters.
  'Note   that   this   only   redivsents   the   PUBLIC   portion   of   the   DevMode.
  '     The   full   DevMode   also   contains   a   variable   length   PRIVATE   section
  '     which   varies   in   length   and   content   between   printer   drivers.
  'NEVER   use   this   User   Defined   Type   directly   with   any   API   call.
  '     Always   combine   it   into   a   FULL   DevMode   structure   and   then   send   the
  '     full   DevMode   to   the   API   call.
  Private Type DEVMODE
          dmDeviceName   As String * CCHDEVICENAME
          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 * CCHFORMNAME
          dmLogPixels   As Integer
          dmBitsPerPel   As Long
          dmPelsWidth   As Long
          dmPelsHeight   As Long
          dmDisplayFlags   As Long
          dmDisplayFrequency   As Long
          dmICMMethod   As Long                   '   //   Windows   95   only
          dmICMIntent   As Long                   '   //   Windows   95   only
          dmMediaType   As Long                   '   //   Windows   95   only
          dmDitherType   As Long                 '   //   Windows   95   only
          dmReserved1   As Long                   '   //   Windows   95   only
          dmReserved2   As Long                   '   //   Windows   95   only
  End Type
  
  Private Type PRINTER_DEFAULTS
  'Note:
  '     The   definition   of   Printer_Defaults   in   the   VB5   API   viewer   is  

incorrect.
  '     Below,   pDevMode   has   been   corrected   to   LONG.
          pDatatype   As String
          pDevMode   As Long
          DesiredAccess   As Long
  End Type
  
  
  '------DECLARATIONS
  
  Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal

pPrinterName As String, phPrinter As Long, pDefault As PRINTER_DEFAULTS) 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
  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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource

As Any, ByVal cbCopy As Long)
  Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
  
  'The   following   is   an   unusual   declaration   of   DocumentProperties:
  '     pDevModeOutput   and   pDevModeInput   are   usually   declared   ByRef.     They   are  

declared
  '     ByVal   in   this   program   because   we're   using   a   Printer_Info_2   structure.
  '     The   pi2   structure   contains   a   variable   of   type   LONG   which   contains  

the   address
  '     of   the   DevMode   structure   (this   is   called   a   pointer).     This   LONG  

variable   must
  '     be   passed   ByVal.
  '     Normally   this   function   is   called   with   a   BYTE   ARRAY   which   contains  

the   DevMode
  '     structure   and   the   Byte   Array   is   passed   ByRef.
  Private Declare Function DocumentProperties Lib "winspool.drv" Alias "DocumentPropertiesA"

(ByVal hwnd As Long, ByVal hPrinter As Long, ByVal pDeviceName As String, ByVal pDevModeOutput As

Any, ByVal pDevModeInput As Any, ByVal fMode As Long) As Long
  
  Private Sub SetOrientation(NewSetting As Long, chng As Integer, ByVal frm As Form)
          Dim PrinterHandle     As Long
          Dim PrinterName     As String
          Dim pd     As PRINTER_DEFAULTS
          Dim MyDevMode     As DEVMODE
          Dim Result     As Long
          Dim Needed     As Long
          Dim pFullDevMode     As Long
          Dim pi2_buffer()     As Long             'This   is   a   block   of   memory   for  

the   Printer_Info_2   structure
                  'If   you   need   to   use   the   Printer_Info_2   User   Defined   Type,  

the
                  '     definition   of   Printer_Info_2   in   the   API   viewer   is  

incorrect.
                  '     pDevMode   and   pSecurityDescriptor   should   be   defined   As   Long.
          
          PrinterName = Printer.DeviceName
          If PrinterName = "" Then
                  Exit Sub
          End If
          
          pd.pDatatype = vbNullString
          pd.pDevMode = 0&
          'Printer_Access_All   is   required   for   NT   security
          pd.DesiredAccess = PRINTER_ALL_ACCESS
          
          Result = OpenPrinter(PrinterName, PrinterHandle, pd)
          
          'The   first   call   to   GetPrinter   gets   the   size,   in   bytes,   of   the  

buffer   needed.
          'This   value   is   divided   by   4   since   each   element   of   pi2_buffer   is  

a   long.
          Result = GetPrinter(PrinterHandle, 2, ByVal 0&, 0, Needed)
          ReDim pi2_buffer((Needed \ 4))
          Result = GetPrinter(PrinterHandle, 2, pi2_buffer(0), Needed, Needed)
          
          'The   seventh   element   of   pi2_buffer   is   a   Pointer   to   a   block   of  

memory
          '     which   contains   the   full   DevMode   (including   the   PRIVATE   portion).
          pFullDevMode = pi2_buffer(7)
          
          'Copy   the   Public   portion   of   FullDevMode   into   our   DevMode   structure
          Call CopyMemory(MyDevMode, ByVal pFullDevMode, Len(MyDevMode))
          
          'Make   desired   changes
          MyDevMode.dmDuplex = NewSetting
          MyDevMode.dmFields = DM_DUPLEX Or DM_ORIENTATION
          MyDevMode.dmOrientation = chng
          
          'Copy   our   DevMode   structure   back   into   FullDevMode
          Call CopyMemory(ByVal pFullDevMode, MyDevMode, Len(MyDevMode))
          
          'Copy   our   changes   to   "the   PUBLIC   portion   of   the   DevMode"   into  

"the   PRIVATE   portion   of   the   DevMode"
          Result = DocumentProperties(frm.hwnd, PrinterHandle, PrinterName, ByVal pFullDevMode,

ByVal pFullDevMode, DM_IN_BUFFER Or DM_OUT_BUFFER)
          
          'Update   the   printer's   default   properties   (to   verify,   go   to   the  

Printer   folder
          '     and   check   the   properties   for   the   printer)
          Result = SetPrinter(PrinterHandle, 2, pi2_buffer(0), 0&)
          
          Call ClosePrinter(PrinterHandle)
          
          'Note:   Once   "Set   Printer   =   "   is   executed,   anywhere   in   the   code,  

after   that   point
          '             changes   made   with   SetPrinter   will   ONLY   affect   the   system

-wide   printer     --
          '             --   the   changes   will   NOT   affect   the   VB   printer   object.
          '             Therefore,   it   may   be   necessary   to   reset   the   printer  

object's   parameters   to
          '             those   chosen   in   the   devmode.
          Dim p     As Printer
          For Each p In Printers
                  If p.DeviceName = PrinterName Then
                          Set Printer = p
                          Exit For
                  End If
          Next p
          Printer.Duplex = MyDevMode.dmDuplex
  End Sub
'横向打印
  Public Sub ChngPrinterOrientationLandscape(ByVal frm As Form)
          PageDirection = 2
          Call SetOrientation(DMDUP_SIMPLEX, PageDirection, frm)
  End Sub
  
  Public Sub ResetPrinterOrientation(ByVal frm As Form)
    
          If PageDirection = 1 Then
                  PageDirection = 2
          Else
                  PageDirection = 1
          End If
          Call SetOrientation(DMDUP_SIMPLEX, PageDirection, frm)
  End Sub
'纵向打印
  Public Sub ChngPrinterOrientationPortrait(ByVal frm As Form)
  
          PageDirection = 1
          Call SetOrientation(DMDUP_SIMPLEX, PageDirection, frm)
  End Sub
 
  评论这张
 
阅读(9093)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017