|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (Impressões/Impressoras)
|
|
 |
Título da Dica: Emissão de etiquetas e outras facilidades com objeto PRINTER.
|
 |
|
|
|
Postada em 13/2/2004 por PC
'COLE ISTO EM UM MODULE:
Option Explicit
Public Enum MyEtiquetas
Avery5160 = 0
Avery5096 = 1
End Enum
Public HorizontalMargin, VerticalMargin As Single
'---------------------------------------------------------------------------------------
' Procedure : PrintEtiqueta
' DateTime : 11/01/2004 15:51
' Author : Paulo Cezar Barbosa, www.sharmaq.com.br
' Purpose : Rotina para imprimir etiquetas mais facilmente
'---------------------------------------------------------------------------------------
'
Sub PrintEtiqueta(Modelo As MyEtiquetas, Linha As Single, Coluna As Single, Texto1 As String, Optional Texto2 As String = "", Optional Texto3 As String = "", Optional Texto4 As String = "", Optional Texto5 As String = "")
'Etiqueta Avery 5160 (2,5 x 6,6 cm)
'Etiqueta Avery 5096 (9,6 x 9,6 cm)
Coluna = Coluna - 1
Linha = Linha - 1
If Modelo = Avery5160 Then
Printer.CurrentX = 0.48 + (6.98 * Coluna)
Printer.CurrentY = 1.27 + (2.54 * Linha)
Printer.FontBold = True
Printer.Print Texto1
Printer.FontBold = False
If Texto2 <> "" Then
Printer.CurrentX = 0.48 + (6.98 * Coluna)
Printer.CurrentY = 1.27 + (2.54 * Linha) + Printer.TextHeight("A") + 0.1
Printer.Print Texto2
End If
If Texto3 <> "" Then
Printer.CurrentX = 0.48 + (6.98 * Coluna)
Printer.CurrentY = 1.27 + (2.54 * Linha) + (Printer.TextHeight("A") + 0.1) * 2
Printer.Print Texto3
End If
If Texto4 <> "" Then
Printer.CurrentX = 0.48 + (6.98 * Coluna)
Printer.CurrentY = 1.27 + (2.54 * Linha) + (Printer.TextHeight("A") + 0.1) * 3
Printer.Print Texto4
End If
If Texto5 <> "" Then
Printer.CurrentX = 0.48 + (6.98 * Coluna)
Printer.CurrentY = 1.27 + (2.54 * Linha) + (Printer.TextHeight("A") + 0.1) * 4
Printer.Print Texto5
End If
End If
If Modelo = Avery5096 Then
Printer.CurrentX = 0.32 + (6.98 * Coluna)
Printer.CurrentY = 1.27 + (7.62 * Linha)
Printer.FontBold = True
Printer.Print Texto1
Printer.FontBold = False
If Texto2 <> "" Then
Printer.CurrentX = 0.32 + (6.98 * Coluna)
Printer.CurrentY = 1.27 + (7.62 * Linha) + (Printer.TextHeight("A") + 0.1)
Printer.Print Texto2
End If
If Texto3 <> "" Then
Printer.CurrentX = 0.32 + (6.98 * Coluna)
Printer.CurrentY = 1.27 + (7.62 * Linha) + (Printer.TextHeight("A") + 0.1) * 2
Printer.Print Texto3
End If
If Texto4 <> "" Then
Printer.CurrentX = 0.32 + (6.98 * Coluna)
Printer.CurrentY = 1.27 + (7.62 * Linha) + (Printer.TextHeight("A") + 0.1) * 3
Printer.Print Texto4
End If
If Texto5 <> "" Then
Printer.CurrentX = 0.32 + (6.98 * Coluna)
Printer.CurrentY = 1.27 + (7.62 * Linha) + (Printer.TextHeight("A") + 0.1) * 4
Printer.Print Texto5
End If
End If
End Sub
'----------------------------------
'Setup Printer
'This is needed for most of the
'procedures and functions in this
'module to work.
'----------------------------------
Public Sub SetupPrinter()
'Set printer's scale to centimeters
Printer.ScaleMode = vbCentimeters
'Set paper margin
HorizontalMargin = 1 + ((21 - Printer.ScaleWidth) / 2)
VerticalMargin = 1.5 + ((29.7 - Printer.ScaleHeight) / 2)
End Sub
'----------------------------------
'Quick Print
'----------------------------------
Public Sub QuickPrint(strPrintText)
Printer.Print "";
Printer.Print strPrintText
Printer.EndDoc
End Sub
'----------------------------------
'Easily reset font types and sizes
'----------------------------------
Public Sub SetFont(size As Integer, b, i, u, s As Boolean, Optional NameF As String = "Arial")
With Printer
'Set the fonts
.ForeColor = RGB(0, 0, 0) 'Black color
'Making Arial font type the default font
.FontName = NameF
'These are all variables
.FontSize = size
.FontBold = b
.FontItalic = i
.FontUnderline = u
.FontStrikethru = s
End With
End Sub
'------------------------
'Justify center
'-------------------------
Public Sub AlignCenter(ByVal strText As String)
Printer.CurrentX = ((Printer.ScaleWidth - Printer.TextWidth(strText)) / 2)
End Sub
'------------------------
'Justify right
'-------------------------
Public Sub AlignRight(ByVal strText As String)
Printer.CurrentX = Printer.ScaleWidth - 2
End Sub
'------------------------
'Justify left
'-------------------------
Public Sub AlignLeft(ByVal strText As String)
Printer.CurrentX = Printer.CurrentX + 2
End Sub
'-------------------------
'Get Current X
'-------------------------
Public Function GetX() As Single
GetX = Printer.CurrentX
End Function
'-------------------------
'Get current Y
'-------------------------
Public Function GetY() As Single
GetY = Printer.CurrentY
End Function
'------------------------
'Print line
'-------------------------
Public Sub PrintLine(Optional LeftPos As Single = 0)
Printer.Line (LeftPos, Printer.CurrentY)-(Printer.ScaleWidth, Printer.CurrentY)
End Sub
'-------------------
'Check Page length
'-------------------
Public Sub CheckPageLen()
If EndOfPage Then
Printer.NewPage
End If
End Sub
'------------------------
'Check for End-of-Page
'-------------------------
Public Function EndOfPage() As Boolean
Dim n As Single
n = Printer.ScaleHeight - 2
If Printer.CurrentY = n Then EndOfPage = True
End Function
'-------------------------------------------------------------
'Print header/footer/page number
'-------------------------------------------------------------
Public Sub PrintHeader(strheader As String)
Printer.CurrentY = VerticalMargin - 1
Printer.CurrentX = HorizontalMargin
Printer.Print "";
SetFont 36, True, True, True, False
pCenter strheader
Printer.Print strheader
Printer.EndDoc
End Sub
Public Sub PrintFooter(strfooter As String)
Printer.CurrentY = Printer.ScaleHeight - 1.5
Printer.CurrentX = HorizontalMargin
Printer.Print "";
SetFont 12, False, False, False, False
pCenter strfooter
Printer.Print strfooter
Printer.EndDoc
End Sub
Public Sub PrintPageNum(PageNum As String)
With Printer
.CurrentY = Printer.ScaleHeight - 0.5
.CurrentX = HorizontalMargin
End With
SetFont 10, False, False, False, False
pCenter PageNum
Printer.Print "";
Printer.Print PageNum
Printer.EndDoc
End Sub
'PARA CHAMAR FAÇA ASSIM:
SetupPrinter
SetFont 10, False, False, False, False
PrintEtiqueta Avery5160, 1, 1, "Linha 1", "Linha 2", "Linha 3", "Linha 4", "Linha 5"
PrintEtiqueta Avery5160, 1, 2, "Linha 1a", "Linha 2a", "Linha 3a", "Linha 4a", "Linha 5a"
|
|
|
|
|
