Número de série em doc do word

[Visitante]

Preciso de ajuda para resolver um problema com o Word. Agradeco desde já aqueles que puderem me ajudar. O caso é o seguinte: tenho um modelo de formulário criado no Word, no canto superior direito deste formulário tem uma numeração (por exemplo: Formulário 0023/03), a cada vez que eu imprimo este formulário eu devo alterar esta numeração (0024/03, 0025/03, 0026/03,...), mas esta alteração é feita de forma manual, tenho um controle do ultimo numero impresso anotado em um papel. Quero saber se é possível automatizar esta numeração usando controles VB ou de alguma outra forma. Devo também explicar que o numero é composto de duas partes a primeira (antes da barra) é sequencial e a segunda (depois da barra) é o ano.

Agradeço a quem puder me ajudar.

[Ripirraitec]

Ia te enviar por e-mail, mas como está oculto... aqui vai:

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

' ---------------------------------------------------------