Ao imprimir estiquetas (aquelas destacáveis) nos deparamos com a questão do possível desperdício: a folha tem, digamos, 20 etiquetas (2col x 10etiq) e imprimimos apenas 15. O restante se perde, a não ser que tenhamos como controlar em que ponto a impressão inicia.
É isto que o código abaixo faz: uma caixa de diálogo pergunta quantas etiquetas deverão ser "puladas", e, além disso, numa 2ª caixa de diálogo podemos definir quantas cópias queremos imprimir de cada etiqueta.
Em um novo módulo:
Option Compare Database
Option Explicit
' Obtido no Artigo Q95806 - "ACC: How to Skip Used Mailing Labels
' and Print Duplicates", da Knowledge Base da Microsoft
' não coloco o link pois está quebrado
Dim LabelBlanks% 'o símbolo '%' significa Integer
Dim LabelCopies%
Dim BlankCount%
Dim CopyCount%
'============================================================
' A seguinte função, colocada no evento Ao Abrir do Re-
' latório, abrirá uma Input Box perguntando ao usuário
' qual o número de etiquetas usadas anteriormente a ser
' pulado e quantas cópias de cada etiqueta serão impressas
'============================================================
Function LabelSetup()
LabelBlanks% = Val(InputBox$("Entre com o nº de etiquetas já usadas." _
& vbCrLf & "As etiquetas usadas serão puladas.", "Imprime Etiqueta"))
LabelCopies% = Val(InputBox$("Entre com o nº de cópias a imprimir" & vbCrLf _
& "de cada etiqueta.", "Imprime Etiqueta"))
If LabelBlanks% < 0 Then LabelBlanks% = 0
If LabelCopies% < 1 Then LabelCopies% = 1
End Function
'===========================================================
' A seguinte função torna as variáveis igual a zero e é
' usada no evento Ao Formatar do cabeçalho do Relatório.
'===========================================================
Function LabelInitialize()
BlankCount% = 0
CopyCount% = 0
End Function
'===========================================================
' A seguinte função é a parte principal deste código que
' permite que as etiquetas sejam impressas conforme o
' desejo do usuário manifestado nas Input Boxes.
' Deve ser colocada no evento OnPrint da Seção Detalhe.
'===========================================================
Function LabelLayout(R As Report)
If BlankCount% < LabelBlanks% Then
R.NextRecord = False
R.PrintSection = False
BlankCount% = BlankCount% + 1
Else
If CopyCount% < (LabelCopies% - 1) Then
R.NextRecord = False
CopyCount% = CopyCount% + 1
Else
CopyCount% = 0
End If
End If
End Function
Observação: se deixar as inputbox's vazias ou colocar 1 dá na mesma > vai imprimir uma etiqueta de cada a partir da 1ª posição.
Exemplo:
É isto que o código abaixo faz: uma caixa de diálogo pergunta quantas etiquetas deverão ser "puladas", e, além disso, numa 2ª caixa de diálogo podemos definir quantas cópias queremos imprimir de cada etiqueta.
Em um novo módulo:
Option Compare Database
Option Explicit
' Obtido no Artigo Q95806 - "ACC: How to Skip Used Mailing Labels
' and Print Duplicates", da Knowledge Base da Microsoft
' não coloco o link pois está quebrado
Dim LabelBlanks% 'o símbolo '%' significa Integer
Dim LabelCopies%
Dim BlankCount%
Dim CopyCount%
'============================================================
' A seguinte função, colocada no evento Ao Abrir do Re-
' latório, abrirá uma Input Box perguntando ao usuário
' qual o número de etiquetas usadas anteriormente a ser
' pulado e quantas cópias de cada etiqueta serão impressas
'============================================================
Function LabelSetup()
LabelBlanks% = Val(InputBox$("Entre com o nº de etiquetas já usadas." _
& vbCrLf & "As etiquetas usadas serão puladas.", "Imprime Etiqueta"))
LabelCopies% = Val(InputBox$("Entre com o nº de cópias a imprimir" & vbCrLf _
& "de cada etiqueta.", "Imprime Etiqueta"))
If LabelBlanks% < 0 Then LabelBlanks% = 0
If LabelCopies% < 1 Then LabelCopies% = 1
End Function
'===========================================================
' A seguinte função torna as variáveis igual a zero e é
' usada no evento Ao Formatar do cabeçalho do Relatório.
'===========================================================
Function LabelInitialize()
BlankCount% = 0
CopyCount% = 0
End Function
'===========================================================
' A seguinte função é a parte principal deste código que
' permite que as etiquetas sejam impressas conforme o
' desejo do usuário manifestado nas Input Boxes.
' Deve ser colocada no evento OnPrint da Seção Detalhe.
'===========================================================
Function LabelLayout(R As Report)
If BlankCount% < LabelBlanks% Then
R.NextRecord = False
R.PrintSection = False
BlankCount% = BlankCount% + 1
Else
If CopyCount% < (LabelCopies% - 1) Then
R.NextRecord = False
CopyCount% = CopyCount% + 1
Else
CopyCount% = 0
End If
End If
End Function
Observação: se deixar as inputbox's vazias ou colocar 1 dá na mesma > vai imprimir uma etiqueta de cada a partir da 1ª posição.
Exemplo:
Última edição por norbs em 2/12/2011, 01:17, editado 1 vez(es)