[Resolvido]Etiqueta de Volumes

Bom dia amigos do forum.

Mais uma vez recorro aos caros colegas para me auxiliarem.

Utilizando um modelo aqui do forum criei um relatório "etiqueta" que já roda bem com o código abaixo...

Descrevendo o funcionamento:

Situação correta: O produto tem qtde 1 e 2 volumes, é impresso duas etiquetas sendo a 1ª (1/2) e a 2ª (2/2), comportamento correto.

Situação errada: Ocorre ao imprimir etiquetas de produto com a Qtde maior que 1 e volumes maior que 1, tomemos este exemplo: Qtde de itens 3, Qtde de volumes 4

Sequencia de impressão: 1/4; 1/4; 1/4; 2/4; 2/4; 2/4; 3/4; 3/4; 3/4; 4/4; 4/4; 4/4
Sequencia pretendida     1/4; 2/4; 3/4; 4/4; 1/4; 2/4; 3/4; 4/4; 1/4; 2/4; 3/4; 4/4

Já tentei várias formas aqui mas meu conhecimento é um pouco limitado

Só registrando: Utilizo impressora Zebra etiquetas 100x50 em rolo dai a necessidade da sequencia descrita acima.

Eis o código que uso para gerar a etiqueta:

Private Sub Comando29_Click()
On Error GoTo y1:
Dim i, qr
qr = Me.repetiçao
DoCmd.SetWarnings False
If ExisteTabela("n") Then
CurrentDb.Execute "DROP TABLE N"
Else
End If
If ExisteTabela("n1") Then
CurrentDb.Execute "DROP TABLE N1"
Else
End If
i = IIf((Me.Vol / qtdpadrao) - Int(Me.Vol / qtdpadrao) > 0, Int(Me.Vol / qtdpadrao), Me.Vol / qtdpadrao)
CurrentDb.Execute "SELECT 1 AS n INTO n": CurrentDb.Execute "SELECT 1 AS n INTO n1"
If Int(i) >= Int(qr) Then Call insere(i) Else Call insere(qr)

If Me.tipoetiqueta = "1" And Me.Opção43.Value = -1 Then
Dim StDocName As String
StDocName = "Rlt_910_Etiquetafinal"
DoCmd.OpenReport StDocName
Else
stdocname1 = "Rlt_910_Etiquetafinal"
DoCmd.OpenReport stdocname1, acViewPreview
End If
DoCmd.SetWarnings True
Exit Sub
y1: MsgBox Err.Description
End Sub

Fico lhes grato por qualquer auxílio.

Sistema operacional Windows 7 Access 2013

Boa noite, tente fazer a alteração em vermelho

Private Sub Comando29_Click()
On Error GoTo y1:
Dim i, qr
qr = Me.repetiçao
DoCmd.SetWarnings False
If ExisteTabela("n") Then
CurrentDb.Execute "DROP TABLE N"
Else
End If
If ExisteTabela("n1") Then
CurrentDb.Execute "DROP TABLE N1"
Else
End If
i = IIf((Me.Vol / qtdpadrao) - Int(Me.Vol / qtdpadrao) > 0, Int(Me.Vol / qtdpadrao) +1, Me.Vol / qtdpadrao)
CurrentDb.Execute "SELECT 1 AS n INTO n": CurrentDb.Execute "SELECT 1 AS n INTO n1"
If Int(i) >= Int(qr) Then Call insere(i) Else Call insere(qr)

If Me.tipoetiqueta = "1" And Me.Opção43.Value = -1 Then
Dim StDocName As String
StDocName = "Rlt_910_Etiquetafinal"
DoCmd.OpenReport StDocName
Else
stdocname1 = "Rlt_910_Etiquetafinal"
DoCmd.OpenReport stdocname1, acViewPreview
End If
DoCmd.SetWarnings True
Exit Sub
y1: MsgBox Err.Description
End Sub

Olá Fernando obrigado pela atenção.

Fiz o procedimento de alteração conforme o descrito, mas não alterou a sequencia de impressão...

Vou seguindo imprimindo os produtos de um em um até lograr exito na configuração...

Mas valeu mesmo pela atenção dispensada, qualquer nova sugestão estou apostos.

Grato.

Boa tarde, se quiser postar parte do banco ficaria mais facil tentarmos ajudar.

Boa tarde amigo, veja se te ajuda.
Essa foi uma colaboração do nosso amigo Liomar do Forum Access há um tempo atrás.

1.No formulário de onde está chamando o Relatório, crie duas Caixas de Texto: TxtNrTotal e TxtNrAtual (desacopladas).

2.No código do botão de Comando deste Formulário que abre o Relatório, escreva:

Dim n As Integer, i As Integer
Me.TxtNrAtual = ""
n = Me.TxtNrTotal.Value
For i = 1 To n
Me.TxtNrAtual = i
DoCmd.OpenReport "NomedeSeuRelatorio", acViewNormal
Next i

Obs. Basta digitar na Caixa de Texto total o nº total de volumes e o código implementará o valor para TxtNrAtual.

3.No rodapé do seu Relatório, crie uma Caixa de Texto desacoplada, por nome TxtVolume (dimensione ela adequadamente) e no evento “Ao formatar” do rodapé, escreva:

Me.TxtVolume = "Volume " & Forms!SeuFormulario!TxtNrAtual & " de " & Forms!SeuFormulario!TxtNrTotal

Bem meus camaradas... após um tempo e usando várias ideias dos amigos... questão resolvida...

Segue o código para quem necessitar...

Private Sub Comando13_Click()
On Error GoTo y1:
Dim i, qr
If IsNull(qtd) Or IsNull(qtdpadrao) Or IsNull(posiçao) Or IsNull(repetiçao) Then
MsgBox "Campos ""Qtd Total"", ""Qtd Padrão na Caixa"", ""Posição"", ""Qtd de Repetição"" Não podem ser nulos!": Exit Sub
End If
If Me.posiçao = 0 Or Me.repetiçao = 0 Then
  MsgBox "O campo ""Posição"" nem ""Repetição"" podem ser 0":
  If Me.posiçao = 0 Then Me.posiçao = 1:
  If Me.repetiçao = 0 Then Me.repetiçao = 1:
  Exit Sub
End If
If Not IsNumeric(qtd) Or Not IsNumeric(qtdpadrao) Or Not IsNumeric(posiçao) Or Not IsNumeric(repetiçao) Then
MsgBox "Os Campos ""Qtd Total"", ""Qtd Padrão na Caixa"", ""Posição"", ""Qtd de Repetição"" tem que ser Números!": Exit Sub
End If
If IsNull(Me.posiçao) Or IsNull(Me.repetiçao) Or IsNull(Me.IdCli) Or IsNull(Me.Cliente) Or IsNull(Me.protpcor) Or IsNull(Me.IdProd) _
Or IsNull(Me.qtd) Or IsNull(Me.qtdpadrao) Or IsNull(Me.tipoetiqueta) Then
MsgBox "Não pode haver nenhum campo sem dados!"
Exit Sub
End If
qr = Me.repetiçao
DoCmd.SetWarnings False
If ExisteTabela("n") Then
CurrentDb.Execute "DROP TABLE N"
Else
End If
If ExisteTabela("n1") Then
CurrentDb.Execute "DROP TABLE N1"
Else
End If
i = IIf((Me.Vol / qtdpadrao) - Int(Me.Vol / qtdpadrao) > 0, Int(Me.Vol / qtdpadrao), Me.Vol / qtdpadrao)
CurrentDb.Execute "SELECT 1 AS n INTO n": CurrentDb.Execute "SELECT 1 AS n INTO n1"
If Int(i) >= Int(qr) Then Call insere(i) Else Call insere(qr)

If Me.tipoetiqueta = "1" Then
Dim StDocName As String
Dim StLinkCriteria As String
StDocName = "Rlt_910_Etiquetafinal"
DoCmd.OpenReport StDocName, acViewPreview
 
Me.Combinação41.Value = ""
End If
DoCmd.SetWarnings True
Exit Sub
y1: MsgBox Err.Description
End Sub

Grato aos colaboradores de plantão pelas dicas

Agradecido...

Boa noite!

Agradecemos o retorno e a solução aplicada.