[Resolvido]access word

boa noite, precisaria colocar dentro de "Do While Not rs.EOF
" que os campos(admissao, demissao, empresa e profissao) ficassem em colunas, obrigado...


On Error GoTo MergeButton_Err


Dim objWord As Word.Application, rs As Recordset
Set rs = CurrentDb.OpenRecordset("tb_carteiratrabalho")

'Copy the Photo control on the Employees form.
DoCmd.GoToControl "reclamante"
DoCmd.RunCommand acCmdCopy

'Start Microsoft Word 97.
Set objWord = CreateObject("Word.Application")

With objWord
'Make the application visible.
.Visible = True

'Open the document.
.Documents.Open ("C:\Documents and Settings\Claudio\Meus documentos\PericiaMédica\modelopm.doc")

'Move to each bookmark and insert text from the form.
.ActiveDocument.Bookmarks("reclamante").Select
.Selection.Text = (CStr(rs!Reclamante))

.ActiveDocument.Bookmarks("reclamante2").Select
.Selection.Text = (CStr(rs!Reclamante))

Do While Not rs.EOF
.ActiveDocument.Bookmarks("admissao").Select
.Selection.Text = (CStr(rs!Admissao))

.ActiveDocument.Bookmarks("demissao").Select
.Selection.Text = (CStr(rs!Demissao))

.ActiveDocument.Bookmarks("empresa").Select
.Selection.Text = (CStr(rs!Empresa))

.ActiveDocument.Bookmarks("profissao").Select
.Selection.Text = (CStr(rs!Profissao))

rs.MoveNext
Loop

End With

'Print the document in the foreground so Microsoft Word will not close
'until the document finishes printing.
objWord.ActiveDocument.PrintOut Background:=False

'Close the document without saving changes.
objWord.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges

'Quit Microsoft Word and release the object variable.
objWord.Quit
Set objWord = Nothing
Exit Sub

MergeButton_Err:
'If a field on the form is empty, remove the bookmark text, and
'continue.
If Err.Number = 94 Then
objWord.Selection.Text = ""
Resume Next

'If the x field is empty.
ElseIf Err.Number = 2046 Then
MsgBox "Please add a x to this record and try again."
Else
MsgBox Err.Number & vbCr & Err.Description
End If

Exit Sub

End Sub

Você pode fazer isso direto no doc, basta posicionar os marcadores da forma que deseja.

Criquio,

deixei anexo o texto que deverei preencher, mais o problema é na tabela que deverei colocar as colunas, tentei já fazer direto no word...
tem cura isto que estou tentando?!

Criquio, acho que vou criar uma imagem da tabela e mandar para o word...será...

///

E o que é exatamente que você está tentando que não ficou claro? As colunas a que você se referem são as da tabela que tem ADMISSÃO, DEMISSÃO, EMPRESA e FUNÇÃO? Se for, os marcadores não estão nos locais corretos? Essa tabela será sempre preenchida com as sete linhas que tem nela ou menos ou pode acontecer de ter mais linhas? Se for no máximo essas sete, nomeie as colunas como adm1, dem1, emp1, fun1, adm2, dem2, emp2, fun2... fun7 por exemplo e na função do Access basta acrescentar uma variável Integer dentro do loop que será incrementada em 1 a cada passagem e adicioná-los segundo o número dessa variável:

Dim objWord As Word.Application, rs As Recordset, N As Integer
N = 1
...
...
...
Do While Not rs.EOF
.ActiveDocument.Bookmarks("adm" & N).Select
.Selection.Text = (CStr(rs!Admissao))

.ActiveDocument.Bookmarks("dem" & N).Select
.Selection.Text = (CStr(rs!Demissao))

.ActiveDocument.Bookmarks("emp" & N).Select
.Selection.Text = (CStr(rs!Empresa))

.ActiveDocument.Bookmarks("fun" & N).Select
.Selection.Text = (CStr(rs!Profissao))

rs.MoveNext
N = N + 1
Loop
...
...
...

Criquio, não me dei conta em concatenar a variavel,mais uma vez, obrigado ...

de volta,
pessoal porque que não consigo transferir os campo "cartidentid" e "jornada" para o documento modeloPM.doc

... grato...

On Error GoTo MergeButton_Err


Dim objWord As Word.Application, rs As Recordset, N As Integer
N = 1
Set rs = CurrentDb.OpenRecordset("tb_carteiratrabalho")

'Copie o controle de fotos no formulário Empregados.
DoCmd.GoToControl "reclamante"
DoCmd.RunCommand acCmdCopy

'Inicie o Microsoft Word 97.
Set objWord = CreateObject("Word.Application")

' Inicia o MS Word 03
'Set oApp = CreateObject("Word.Application") 'Cria e abre o objeto Word
'With oApp
' Torna o MS Word visível
'Visible = True

With objWord
'Faça o aplicativo visível.
.Visible = True

'Abra o documento.
.Documents.Open ("C:\Documents and Settings\Claudio\Meus documentos\PericiaMédica\modelopm.doc")

'Mover para cada indicador e inserir texto de forma.
.ActiveDocument.Bookmarks("reclamante").Select
.Selection.Text = (CStr(rs!Reclamante))
.ActiveDocument.Bookmarks("reclamante2").Select
.Selection.Text = (CStr(rs!Reclamante))
'----------------------
.ActiveDocument.Bookmarks("CartIdentid").Select
.Selection.Text = (CStr(rs!CartIdentid))
'-----------------------

Do While Not rs.EOF
.ActiveDocument.Bookmarks("admissao").Select
.Selection.Text = (CStr(rs!Admissao))
.ActiveDocument.Bookmarks("admissao" & N).Select
.Selection.Text = (CStr(rs!Admissao))
.ActiveDocument.Bookmarks("demissao" & N).Select
.Selection.Text = (CStr(rs!Demissao))
.ActiveDocument.Bookmarks("empresa" & N).Select
.Selection.Text = (CStr(rs!Empresa))
.ActiveDocument.Bookmarks("profissao" & N).Select
.Selection.Text = (CStr(rs!Profissao))
rs.MoveNext
N = N + 1
Loop
'---------------
.ActiveDocument.Bookmarks("jornada").Select
.Selection.Text = (CStr(rs!Jornada))
'--------------
End With

'Imprimir o documento em primeiro plano para o Microsoft Word não vai fechar
'até que termine o documento a imprimir
objWord.ActiveDocument.PrintOut Background:=False

'Fechar o documento sem salvar as alterações.
objWord.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges

'Saia do Microsoft Word e liberar a variável de objeto.
objWord.Quit
Set objWord = Nothing
Exit Sub

MergeButton_Err:
'Se um campo no formulário é vazio, remova o texto marcador e continua
If Err.Number = 94 Then
objWord.Selection.Text = ""
Resume Next

'Se o campo de x está vazio.
ElseIf Err.Number = 2046 Then
MsgBox "Please add a x to this record and try again."
Else
MsgBox Err.Number & vbCr & Err.Description
End If

Exit Sub

End Sub

Por que não consegue? O que acontece? Acusa erro? Qual? Aponta para que linha?

ERRO: 3265
item não encontrada nesta coleção...

Isso acontece quando o nome de algum controle está escrito de forma errada. Verifique na tabela se os nomes de campos estão iguais aos digitados. Verifique no arquivo doc se os nomes dos marcadores estão iguais aos da função.

Críquio,
andei olhando a postagem do Piloto com Críquio e fiz o que foi comentado, verificar os nomes dos campos se batiam... e estão corretos... a lógica do código esta correto?

o reclamante e a tabela que coloco transfere normal, qdo acrescento outro campo qqer ocore o problema...

Tente colocar algo assim nos campos que estão dando problema:

Código:

If rs!Admissao <> "" Then
    .ActiveDocument.Bookmarks("admissao").Select
    .Selection.Text = (CStr(rs!Admissao))
End If

Peguei o admissao apenas como exemplo.

Criquio, ótimas dicas e o ERRO foi meu nome da tabela errada(dormi no ponto), sorry e grato...abç...

Grato pelo retorno. Só faltou clicar no botão Resolvido.

desculpa a ignorância, mais onde tiro a bandeira verde, caso encerrado...

grato...