Basole, verifiquei o arquivo seu em anexo mas está diferente. Veja imagem no anexo do formato que estou usando.
Eu vi uma postagem aqui no forum de 2002, vou disponibilizar aqui. Porém não consegui entender a construção do arquivo .dot final para executar.
Agradeço pela compreensão.
ex.:
Ofício nº. 0120/2021 – GABINETE07/DR.
Assunto: Reforma do balanço na Rua Pedro Barbosa da Silva, 380 - Jardim Alvorada.
Fórumula:
Segue aqui um tutorial de como fazer o seu numerador automático de cartas.
1. Crie um documento com o padrão de suas cartas. No local onde você costuma colocar a numeração, escreva Autonumeração, formatando-a do jeito apropriado e essa palavra será substituída pelo número do documento;
2. Salve esse documento como modelo (.DOT) no diretório apropriado. Esse modelo será sempre utilizado para isso. Pode chamá-lo cartas.dot;
3. Pode fechar esse documento;
4. Abra o normal.dot e copie e cole o código abaixo (tudo o que estiver entre --------------) em um módulo;
4.1 Antes de copiar e colar, altere as linhas necessárias, trocando o caminho onde você grava seus documentos
5. Crie um botão na barra de ferramentas, e associe essa macro (Cartanumerada) a ele;
6. Salve e feche o normal.dot. Feche o Word e reabra. O botão deverá estar lá. Para criar uma nova carta, basta clicar ali.
Fim
Se você já tiver uma numeração em andamento, altere no arquivo cartas.ini, que será criado após a primeira utilização, a linha CartaNum= para o valor apropriado (deverá constar o último número utilizado).
Qualquer dúvida, entre em contato.
Cesar
‘ ------------------------------------------------------------------
Sub Cartanumerada()
On Error GoTo Erro
Documents.Add Template:="cartas.dot"
' *** Diretórios e arquivos - Faça aqui as alterações necessárias ***
DocDir$ = "c:\Meus Documentos\Pessoais\" ' onde gravar os docs
ArqIni$ = "c:\Meus Documentos\Pessoais\Carta.Ini" 'onde armazenará o arquivo ini
' Lê o ano no relógio do PC
AnoAtual$ = Year(Now())
' Testa existência do Arquivo INI
If ArquivoExiste(ArqIni$) <> -1 Then ' Não existe, cria INI
Call ZeraContagem(AnoAtual$, ArqIni$)
Else ' Existe, testa ano; atualiza INI
AnoIni$ = System.PrivateProfileString$(ArqIni$, "Contador", "Ano")
DIf = Val(AnoAtual$) - Val(AnoIni$)
If DIf > 0 Then ' Ano novo
Call ZeraContagem(AnoAtual$, ArqIni$)
ElseIf DIf < 0 Then ' Ano andou para trás; pára macro
MsgBox "Erro no relógio do micro ou arquivo INI adulterado."
GoTo Fim
End If
End If
' Lê o número atual no arquivo INI
nuMicrosoft = System.PrivateProfileString$(ArqIni$, "Contador", "CartaNum")
n = Val(nuMicrosoft) + 1 ' soma 1
Valor$ = Right$("000" & n, 3)
' Texto a incluir. Ex: Carta001/98
AnoAtual$ = Right$(AnoAtual$, 2)
NovoTexto$ = "Carta" + Valor$ + "/" + AnoAtual$
' Escreve número no documento
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
' Caminho e Nome do arquivo DOC com o número. Ex: Fax001-98.doc
nomedoc$ = DocDir$ + Valor$ + "-" + AnoAtual$ + ".doc"
If ArquivoExiste(nomedoc$) = -1 Then
MsgBox "O arquivo " + nomedoc$ + " já existe. Operação cancelada."
Else
' Salva o arquivo e escreve o número no arquivo INI
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$)
' Testa se o arquivo Arq$ existe
On Error GoTo ArqExiste_Err
Open Arq$ For Input As #1
Close #1
ArquivoExiste = -1 'Existe
GoTo FimArq
ArqExiste_Err:
ArquivoExiste = 0 'Não Existe
FimArq:
End Function
Sub ZeraContagem(AnoNovo$, Ini$)
' Grava o ano atual, zera a contagem
System.PrivateProfileString(Ini$, "Contador", "Ano") = AnoNovo$
System.PrivateProfileString(Ini$, "Contador", "CartaNum") = "0"
End Sub
' ---------------------------------------------------------