Postada em 31/12/2010 09:38 hs
Alguém pode me explicar o pq que este codigo nao funciona, antes estava funcionando derrepente parou de funcionar.
Dim CaminhoCartas As String
Dim conta As Integer
Dim NomeArquivo As String
On Error GoTo ErrorHandler
If txtNomedoArquivo.Text = "" Then
txtNomedoArquivo.Text = txtNome.Text
End If
If txtNomedoArquivo.Text = "" Then
MsgBox "O Nome do Arquivo a ser gerado, deve ser informado.", vbExclamation
txtNomedoArquivo.SetFocus
Exit Sub
End If
CaminhoCartas = CaminhoBD
conta = Len(CaminhoCartas)
conta = conta - 6
CaminhoCartas = Left(CaminhoCartas, conta)
CaminhoCartas = CaminhoCartas & "Arquivos"
Set objword = New word.Application
' Desabilita o botao de comando
'cmdGerarContrato.Enabled = False
' nome do relatorio pré montado
objword.Documents.Open (CaminhoCartas & "Carta01.doc")
' chama rotina para substituicao
Call Substitui_Var("@nome", txtNome)
Call Substitui_Var("@endereco", txtEndereco)
Call Substitui_Var("@Cidade", txtCidade)
Call Substitui_Var("@cep", txtCEP)
Call Substitui_Var("@EnderecoImovel", txtEnderecoImovel)
Call Substitui_Var("@Fiador", txtFiador)
Call Substitui_Var("@Data", DataExtenso)
NomeArquivo = txtNomedoArquivo.Text & ".doc"
' Salva o documento com um novo nome
objword.ActiveDocument.SaveAs (CaminhoCartas & "Cartas Geradas" & NomeArquivo)
'Encerra o word
objword.Quit
' libera memoria
Set objword = Nothing
MsgBox "Carta gerada com sucesso! em : " & CaminhoCartas & "Cartas Geradas", vbInformation, " Carta Gerada "
If MsgBox("Deseja Abrir a Carta Gerada?", vbInformation + vbYesNo, "AVISO") = vbYes Then
' abri o arquivo gerado
Dim word As New word.Application
With word
.Documents.Open (CaminhoCartas & "Cartas Geradas" & NomeArquivo)
.Visible = True
.WindowState = wdWindowStateMaximize
End With
Set word = Nothing
End If
Exit Sub
ErrorHandler: ' Rotina de tratamento de erro.
Select Case Err.Number
Case 5152
MsgBox "Atenção! O Nome da Carta Gerada não pode ter Caracteres Especiais.", vbInformation
Case 5356
MsgBox "Atenção! O Arquivo pode estar aberto na memoria do sistema. Feche o Sistema", vbInformation
End Select
End Sub
Private Sub Substitui_Var(Header As String, Data As String)
On Error GoTo ErrorHandler
With objword.Selection.Find
.ClearFormatting
.Text = Header
.Execute Forward:=True
End With
Clipboard.Clear
Clipboard.SetText (Data)
objword.Selection.Paste
Clipboard.Clear
ErrorHandler: ' Rotina de tratamento de erro.
Select Case Err.Number
Case 4198
MsgBox "Atenção! Falta preencher algum campo do contrato.", vbExclamation
Exit Sub
End Select
End Sub
|
