About Me
Com tecnologia do Blogger.
Seguidores
Estatisticas
2006-03-19
VBA: Sequenciar numeração
7:27 da tarde |
Publicada por
JRod - PORTUGAL |
Editar mensagem
Se pretendermos que uma determinada célula sequencie sempre que quisermos abrir um workbook, podemos utilizar o seguinte código de McGimpsey, com a adaptação no código de abertura do workbook, uma vez que se incluiu no número sequencial o ano, no formato "nn/aa", com a porção de código & "/" & Right(Date, 2)
O código da Função NextSeqNumber():
Public Function NextSeqNumber(Optional sFileName As String, Optional nSeqNumber As Long = -1) As Long
Const sDEFAULT_PATH As String = "C:\GABINETE"
Const sDEFAULT_FNAME As String = "defaultseq.txt"
Dim nFileNumber As Long
nFileNumber = FreeFile
If sFileName = "" Then sFileName = sDEFAULT_FNAME
If InStr(sFileName, Application.PathSeparator) = 0 Then _
sFileName = sDEFAULT_PATH & Application.PathSeparator & sFileName
If nSeqNumber = -1& Then
If Dir(sFileName) <> "" Then
Open sFileName For Input As nFileNumber
Input #nFileNumber, nSeqNumber
nSeqNumber = nSeqNumber + 1&
Close nFileNumber
Else
nSeqNumber = 1&
End If
End If
On Error GoTo PathError
Open sFileName For Output As nFileNumber
On Error GoTo 0
Print #nFileNumber, nSeqNumber
Close nFileNumber
NextSeqNumber = nSeqNumber
Exit Function
PathError:
NextSeqNumber = -1&
End Function
NOTA:
sDEFAULT_PATH e sDEFAULT_FNAME indicados a título de exemplo, podendo ser, como óbvio, alterados.
NOTA:
A célula onde recai o valor sequencial, deve ser formatada como texto.
O Código de abertura do Workbook:
Private Sub Workbook_Open()
ThisWorkbook.Sheets(1).Range("B2").Value = NextSeqNumber & "/" & Right(Date, 2)
End Sub
O resultado:
O código da Função NextSeqNumber():
Public Function NextSeqNumber(Optional sFileName As String, Optional nSeqNumber As Long = -1) As Long
Const sDEFAULT_PATH As String = "C:\GABINETE"
Const sDEFAULT_FNAME As String = "defaultseq.txt"
Dim nFileNumber As Long
nFileNumber = FreeFile
If sFileName = "" Then sFileName = sDEFAULT_FNAME
If InStr(sFileName, Application.PathSeparator) = 0 Then _
sFileName = sDEFAULT_PATH & Application.PathSeparator & sFileName
If nSeqNumber = -1& Then
If Dir(sFileName) <> "" Then
Open sFileName For Input As nFileNumber
Input #nFileNumber, nSeqNumber
nSeqNumber = nSeqNumber + 1&
Close nFileNumber
Else
nSeqNumber = 1&
End If
End If
On Error GoTo PathError
Open sFileName For Output As nFileNumber
On Error GoTo 0
Print #nFileNumber, nSeqNumber
Close nFileNumber
NextSeqNumber = nSeqNumber
Exit Function
PathError:
NextSeqNumber = -1&
End Function
NOTA:
sDEFAULT_PATH e sDEFAULT_FNAME indicados a título de exemplo, podendo ser, como óbvio, alterados.
NOTA:
A célula onde recai o valor sequencial, deve ser formatada como texto.
O Código de abertura do Workbook:
Private Sub Workbook_Open()
ThisWorkbook.Sheets(1).Range("B2").Value = NextSeqNumber & "/" & Right(Date, 2)
End Sub
O resultado: