Ir ao conteúdo
  • Cadastre-se

Visual Basic Numeração automática formulário Word


Posts recomendados

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

Link para o comentário
Compartilhar em outros sites

Segue o arquivo, como não estava funcionando eu retirei esta função, a única configuração que contém nele é a data automática e o preenchimento automático de campos que contem as mesmas informações.

 

Daí eu precisava criar um numero de proposta tipo 01120220 - Número da proposta: 01 e data 120220, daí a configuração deve funcionar para que mude este número somente quando eu salvar o arquivo, porque se eu entrar e consultar e fechar ele vai mudar automaticamente e perder a sequencia que deveria seguir. 

Proposta.docx

Link para o comentário
Compartilhar em outros sites

Sem os outros arquivos envolvidos nao tem como testar e tentar lhe ajudar na questào do formato da numeracao: nnddmmaa

 

Para incrementar a autonumeracão, ou seja executar a macro somente quando salvar o arquivo, coloque o codigo abaixo no modulo ThisDocument.

 

Private WithEvents App As Word.Application

Private Sub Document_Open()
Set App = Word.Application
End Sub

Private Sub App_DocumentBeforeSave(ByVal Doc As Document, SaveAsUI As Boolean, Cancel As Boolean)
Call Cartanumerada
End Sub

 

Link para o comentário
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisa ser um usuário para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...