Segue a função que estou utilizando:
Function Gera_Pacote()
Dim NumLinhas, Contagem As Integer
Dim ArquivoTxt, Pallet, Caixa, MudaCaixa, MudaPallet As Integer
Dim CaixaInicio, CaixaFim, PacoteInicio, PacoteFim, Modelo, Pacote As String
Dim NumIni, NumFim As String
Pacote = 1
PacoteInicio = Range("B3").Value
NumIni = Range("B3").Value
NumFim = Range("D3").Value
Contagem = 0
If Plan1.OptComum.Value = True Then
Modelo = "Comum"
ElseIf Plan1.OptEspecial.Value = True Then
Modelo = "Especial"
End If
ArquivoTxt = FreeFile
Open "C:\Pacote\" & Range("F3").Value & "_Pacote_" & Modelo & ".txt" For Output As #ArquivoTxt
' Print #ArquivoTxt, "Pallet"; vbTab; "CX_NUM"; vbTab; "CX_NUM_INICIO"; vbTab; "CX_NUM_FIM"; vbTab; "PC_NUM"; vbTab; "PC_NUM_FIM"; vbTab; "PC_NUM_INICIO"
NumLinhas = (NumFim - NumIni + 1) / 2000 / 4
NumLinhas = Int(NumLinhas + 0.99)
Caixa = Caixa + 1
Print #ArquivoTxt, "pacote1" & vbTab & "ate1" & vbTab & "de1" & vbTab & "caixa1" & vbTab & "pacote2" & vbTab & "ate2" & vbTab & "de2" & vbTab & "caixa2" & vbTab & "pacote3" & vbTab & "ate3" & vbTab & "de3" & vbTab & "caixa3" & vbTab & "pacote4" & vbTab & "ate4" & vbTab & "de4" & vbTab & "caixa4"
While Contagem < NumLinhas
If PacoteInicio + (NumLinhas * 8000) + 1999 > NumFim + Caixa Then
Print #ArquivoTxt, Pacote + vbTab & Format(PacoteInicio + 1999, "000000000") & vbTab & Format(PacoteInicio, "000000000") & vbTab & Caixa & _
vbTab & Pacote + NumLinhas & vbTab & Format(PacoteInicio + (NumLinhas * 2000) + 1999, "000000000") & vbTab & Format(PacoteInicio + (NumLinhas * 2000), "000000000") & vbTab & Caixa & _
vbTab & Pacote + (NumLinhas * 2) & vbTab & Format(PacoteInicio + (NumLinhas * 4000) + 1999, "000000000") & vbTab & Format(PacoteInicio + (NumLinhas * 4000), "000000000") & vbTab & Caixa & _
vbTab & Pacote + (NumLinhas * 3) & vbTab & Format(PacoteInicio + (NumLinhas * 6000) + 1999, "000000000") & vbTab & Format(PacoteInicio + (NumLinhas * 6000), "000000000") & vbTab & Caixa
Else
Print #ArquivoTxt, Pacote + vbTab & Format(PacoteInicio + 1999, "000000000") & vbTab & Format(PacoteInicio, "000000000") & vbTab & Caixa & _
vbTab & Pacote + NumLinhas & vbTab & Format(PacoteInicio + (NumLinhas * 2000) + 1999, "000000000") & vbTab & Format(PacoteInicio + (NumLinhas * 2000), "000000000") & vbTab & Caixa & _
vbTab & Pacote + (NumLinhas * 2) & vbTab & Format(PacoteInicio + (NumLinhas * 4000) + 1999, "000000000") & vbTab & Format(PacoteInicio + (NumLinhas * 4000), "000000000") & vbTab & Caixa & _
vbTab & Pacote + (NumLinhas * 3) & vbTab & Format(PacoteInicio + (NumLinhas * 6000) + 1999, "000000000") & vbTab & Format(PacoteInicio + (NumLinhas * 6000), "000000000") & vbTab & Caixa
End If
PacoteInicio = PacoteInicio + 2000
Pacote = Pacote + 1
MudaCaixa = MudaCaixa + 1
Contagem = Contagem + 1
If MudaCaixa = 4 Then
MudaCaixa = 0
Caixa = Caixa + 1
End If
Wend
Close #ArquivoTxt
End Function
-----------------------------------------
Imagem do que está acontecendo:
w w w .sendspace.com/file/ujit5m *Favor tirar os espaços para baixar a imagem