Existe a possibilidade de nesse arquivo constar o numero subsequente junto com a data que eu estiver fazendo a proposta, por exemplo 01290120, que seria 01 o número da proposta e 290120 a data da proposta sem o /.
Outro ponto é que quando eu fecho o documento sem salvar ele automaticamente muda a sequencia, gostaria que ele só mudasse quando eu salvasse, pois se eu não salvar e depois abrir novamente ele está alterando a sequencia.
Uma outra questão é que quando salvo este documento na rede, e outra pessoa abre na máquina dela, não está considerando a sequencia, aparece a mensagem "Não é possível executar código em modo de criação".
Sub Cartanumerada()
On Error GoTo Erro
Documents.Add Template:="Nota_debito_center"
DocDir$ = "Z:\Logística\NOTA DEBITO"
ArqIni$ = "Z:\Logística\NOTA DEBITO"
AnoAtual$ = Year(Now())
If ArquivoExiste(ArqIni$) <> -1 Then
Call ZeraContagem(AnoAtual$, ArqIni$)
Else
AnoIni$ = System.PrivateProfileString$(ArqIni$, "Contador", "Ano")
DIf = Val(AnoAtual$) - Val(AnoIni$)
If DIf > 0 Then
Call ZeraContagem(AnoAtual$, ArqIni$)
ElseIf DIf < 0 Then
MsgBox "Erro no relógio do micro ou arquivo INI adulterado."
GoTo Fim
End If
End If
nuMicrosoft = System.PrivateProfileString$(ArqIni$, "Contador", "CartaNum")
n = Val(nuMicrosoft) + 1
Valor$ = Right$("001" & n, 3)
AnoAtual$ = Right$(AnoAtual$, 2)
NovoTexto$ = Valor$ + "/" + AnoAtual$
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Autonumeração"
.Replacement.Text = NovoTexto$
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
nomedoc$ = DocDir$ + Valor$ + "-" + AnoAtual$ + ".doc"
If ArquivoExiste(nomedoc$) = -1 Then
MsgBox "O arquivo " + nomedoc$ + " já existe. Operação cancelada."
Else
ActiveDocument.SaveAs FileName:=nomedoc$
System.PrivateProfileString(ArqIni$, "Contador", "CartaNum") = Valor$
End If
GoTo Fim
Erro:
MsgBox "Não foi possível abrir o Arquivo."
Fim:
End Sub
Function ArquivoExiste(Arq$)
On Error GoTo ArqExiste_Err
Open Arq$ For Input As #1
Close #1
ArquivoExiste = -1
GoTo FimArq
ArqExiste_Err:
ArquivoExiste = 0
FimArq:
End Function
Sub ZeraContagem(AnoNovo$, Ini$)
System.PrivateProfileString(Ini$, "Contador", "Ano") = AnoNovo$
System.PrivateProfileString(Ini$, "Contador", "CartaNum") = "0"
End Sub