MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access


    [Resolvido]Criar arquivo Word com imagem

    Sidney
    Sidney
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 363
    Registrado : 08/10/2012

    [Resolvido]Criar arquivo Word com imagem Empty [Resolvido]Criar arquivo Word com imagem

    Mensagem  Sidney em 30/4/2019, 17:55

    Prezados, Boa tarde!!

    Tem como criar um arquivo word com imagens já inseridas pelo access? essas imagens entrariam como logon no cabeçalho.

    tenho o codigo abaixo que criar o arquivo se não existir, funciona perfeitamente, e gostaria de fazer essa adaptação.
    Código:

    Dim appWord
    Dim doc
    Dim strArquivo$
    strArquivo = "C:\Sistemas\SysCRAS\CRAS_I\SinteseEncaminhamento\" & Forms!frm_Encaminhamento!enc_IF & ".docx"
    'veririfca se o arquivo existe

    If IsNull(Me.enc_IF) Then
            MsgBox "Por favor, selecione um registro.", vbExclamation, "Abrir arquivo word"
            Cancel = True
            
    Else
            If Len(Dir(strArquivo, vbArchive) & "") = 0 Then
                If MsgBox("Arquivo não encontrado.  Deseja criar um novo ?", vbQuestion + vbYesNo, "Confirmação") = vbYes Then
                    'abre o Word
                    Set appWord = CreateObject("Word.Application")
                    'abre um documento novo
                    Set doc = appWord.Documents.Add
                    'salva o documento para o local indicado
                    doc.SaveAs strArquivo, wdFormatDocument
                    'fecha o documento
                    doc.Close
                    'fecha o Word
                    appWord.Quit
                    Set appWord = Nothing
                    MsgBox "Arquivo criado com Sucesso!!", vbInformation, "Aviso"
                    'abre o arquivo que foi criado
                    Application.FollowHyperlink strArquivo, , False
                    
                End If
                
            Else
                'se existe abre o arquivo
                Application.FollowHyperlink strArquivo, , False
                
            End If


    End If


    att; Sidney
    baldocchi
    baldocchi
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 123
    Registrado : 03/11/2014

    [Resolvido]Criar arquivo Word com imagem Empty Re: [Resolvido]Criar arquivo Word com imagem

    Mensagem  baldocchi em 30/4/2019, 18:47

    oi, eu uso indicadores do Word quando preciso gerar algum documento.
    - Primeiro eu gravo um Modelo do Word (.dotx)
    - Depois eu faço como o código abaixo. Não tem imagens, mas espero que ajude.
    Esse código pega o conteúdo dos controles do formulário e joga no documento do Word.

    Não esquece de referenciar o Microsoft Word XX Object Libary

    Public Sub EnviarWordIndicador()
    Dim oApp As Object 'Cria uma variável objeto
    Dim PastaArq, ArqModelo

    'seta pasta do banco de dados
    PastaArq = CurrentProject.Path

    'Indicar nome do arquivo
    'Requerimento Padrão. Argumentos: Nome, Cargo e DataNascimento
    ArqModelo = "ModeloAta.dotx"

    ' Inicia o MS Word
    Set oApp = CreateObject("Word.Application") 'Cria e abre o objeto Word
    ' Torna o MS Word visível
    oApp.Visible = True
    ' Abre o documento base
    oApp.Documents.Add (PastaArq & "\" & ArqModelo)

    'Move cada campo para o indicador definido no documento
    oApp.ActiveDocument.Bookmarks("atadias").Select 'Nome do INDICADOR DO WORD
    oApp.Selection.Text = (Ata_Dias) 'Nome do CAMPO DA TABELA

    oApp.ActiveDocument.Bookmarks("atames").Select
    oApp.Selection.Text = (Ata_Mes)

    oApp.ActiveDocument.Bookmarks("ataano").Select
    oApp.Selection.Text = (Ata_Ano)

    oApp.ActiveDocument.Bookmarks("nomepresidente").Select
    oApp.Selection.Text = (Ata_Presidente)

    oApp.ActiveDocument.Bookmarks("nomeAPM").Select
    oApp.Selection.Text = (NomeAPM)

    oApp.ActiveDocument.Bookmarks("NomedaEscola").Select
    oApp.Selection.Text = (NomeAPM)

    'Data e Hora da reunião da APM
    Dim sDHReuniao, sDHReuniaoL, sDHReuniaoR As String
    sDHReuniaoL = Left(Ata_Hora, 2)
    sDHReuniaoR = Right(Ata_Hora, 2)
    sDHReuniao = sDHReuniaoL & ":" & sDHReuniaoR
    oApp.ActiveDocument.Bookmarks("HorarioDaReuniao").Select
    oApp.Selection.Text = (sDHReuniao) 'Data e Hora da reunião

    'Nome da APM
    oApp.ActiveDocument.Bookmarks("nomedaAPM").Select
    oApp.Selection.Text = (NomeAPM)

    'Número da Convocação da Reunião
    oApp.ActiveDocument.Bookmarks("NumConvocacao").Select
    oApp.Selection.Text = (Ata_Convocacao)

    'Número do Repasse
    oApp.ActiveDocument.Bookmarks("NumRepasse").Select
    oApp.Selection.Text = (Ata_Repasse)

    'Valores Recebidos de Custeio e Capital
    Dim xVr As Double
    xVr = 0
    xVr = Format(Ata_Vr_Rec_Custeio, "0,00#.##")
    oApp.ActiveDocument.Bookmarks("VrRecebidoCusteio").Select
    oApp.Selection.Text = (xVr)

    xVr = 0
    xVr = Format(Ata_Vr_Rec_Capital, "0,00#.##")
    oApp.ActiveDocument.Bookmarks("VrRecebidoCapital").Select
    oApp.Selection.Text = (xVr)

    ' Período de Realização da Despesa
    Dim sFormatDatas, xFormatDatas As String
    xFormatDatas = Ata_Per_Real_Despesas
    sFormatDatas = Left(xFormatDatas, 2)
    sFormatDatas = sFormatDatas & "/" & Mid(xFormatDatas, 3, 2)
    sFormatDatas = sFormatDatas & "/" & Mid(xFormatDatas, 5, 4)
    sFormatDatas = sFormatDatas & " à " & Mid(xFormatDatas, 9, 2)
    sFormatDatas = sFormatDatas & "/" & Mid(xFormatDatas, 11, 2)
    sFormatDatas = sFormatDatas & "/" & Mid(xFormatDatas, 13, 4)
    oApp.ActiveDocument.Bookmarks("AtaPeriodoRealDespesas").Select
    oApp.Selection.Text = (sFormatDatas)

    'Valor da Poupança Ata_Vr_Apl_Poupanca
    xVr = 0
    xVr = Format(Ata_Vr_Apl_Poupanca, "#,##")
    oApp.ActiveDocument.Bookmarks("VrAplicPoupanca").Select
    oApp.Selection.Text = (xVr)

    'Valores Totais de Custeio e Capital Ata_Vr_Total_Custeio Ata_Vr_Tot_Aquis_Capital
    xVr = 0
    xVr = Format(Ata_Vr_Total_Custeio, "0,00#.##")
    oApp.ActiveDocument.Bookmarks("VrRendimentoCusteio").Select
    oApp.Selection.Text = (xVr)

    xVr = 0
    xVr = Format(Ata_Vr_Tot_Aquis_Capital, "0,00#.##")
    oApp.ActiveDocument.Bookmarks("VrRendimentoCapital").Select
    oApp.Selection.Text = (xVr)
    oApp.Application.Quit

    oApp.ActiveDocument.Bookmarks("NomeDoPresidente").Select
    oApp.Selection.Text = (Ata_Presidente)

    oApp.ActiveDocument.Bookmarks("NomeDoPresidente1").Select
    oApp.Selection.Text = (Ata_Presidente)

    'Valor de Aquisições CUSTEIO
    xVr = 0
    xVr = Format(Ata_Vr_Total_Custeio, "0,00#.##")
    oApp.ActiveDocument.Bookmarks("VrAquisCusteio").Select
    oApp.Selection.Text = (xVr)

    'Aquisições de CUSTEIO
    oApp.ActiveDocument.Bookmarks("ProdutosCusteio").Select
    oApp.Selection.Text = (Ata_Aquisicoes_Custeio)

    'Valor de Aquisições CAPITAL
    xVr = 0
    xVr = Format(Ata_Vr_Tot_Aquis_Capital, "0,00#.##")
    oApp.ActiveDocument.Bookmarks("VrAquisCapital").Select
    oApp.Selection.Text = (xVr)

    'Aquisições de CAPITAL
    oApp.ActiveDocument.Bookmarks("ProdutosCapital").Select
    oApp.Selection.Text = (Ata_Aquisicoes_Capital)

    'Dados Bancários da APM
    'Agência
    oApp.ActiveDocument.Bookmarks("Agencia").Select
    oApp.Selection.Text = (Texto81)
    'Conta Corrente
    oApp.ActiveDocument.Bookmarks("ContaCorrente").Select
    oApp.Selection.Text = (Texto83)

    oApp.ActiveDocument.Bookmarks("NomePresidente2").Select
    oApp.Selection.Text = (Ata_Presidente)

    oApp.ActiveDocument.Bookmarks("Quemredigiuaata").Select
    oApp.Selection.Text = (Texto89)

    'Valores RESTANTES de Custeio e Capital
    xVr = 0
    xVr = Format(Texto85.Value, "0,00#.##")
    oApp.ActiveDocument.Bookmarks("VrRestCusteio").Select
    oApp.Selection.Text = (xVr)

    xVr = 0
    xVr = Format(Texto87.Value, "0,00#.##")
    oApp.ActiveDocument.Bookmarks("VrRestCapital").Select
    oApp.Selection.Text = (xVr)

    'Número do Repasse 1
    oApp.ActiveDocument.Bookmarks("NumRepasse1").Select
    oApp.Selection.Text = (Ata_Vr_Rep_Num)

    Set oApp = Nothing

    End Sub
    Mylton
    Mylton
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 720
    Registrado : 23/08/2010

    [Resolvido]Criar arquivo Word com imagem Empty Re: [Resolvido]Criar arquivo Word com imagem

    Mensagem  Mylton em 30/4/2019, 23:36

    Verifique no repositório.
    Lá tem um exemplo.
    Sidney
    Sidney
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 363
    Registrado : 08/10/2012

    [Resolvido]Criar arquivo Word com imagem Empty Re: [Resolvido]Criar arquivo Word com imagem

    Mensagem  Sidney em 2/5/2019, 21:15

    Confesso que estou perdido no seu exemplo baldochi, vou tentar pesquisa novamente.
    Sidney
    Sidney
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 363
    Registrado : 08/10/2012

    [Resolvido]Criar arquivo Word com imagem Empty Re: [Resolvido]Criar arquivo Word com imagem

    Mensagem  Sidney em 3/5/2019, 18:37

    Pessoal Boa tarde!!

    Consegui fazer a implementação com ajuda do mestre Avelino no site Usando Access, ficou perfeito, através de um documento modelo, consigo criar um novo documento já nomeado com o registro atual, com a imagem que preciso e alguns dados inseridos, segue o link.

    Usando Access




    Código:
    Private Sub Bt_Sintese_Click()
    Dim wdApl As Object
    Dim strLocal As String
    Set wdApl = CreateObject("Word.Application")

    'Local do arquivo
    strLocal = "C:\Sistemas\SysCRAS\CRAS_I\SinteseEncaminhamento\" & Forms!frm_Encaminhamento!enc_IF & ".docx"

    If IsNull(Me.enc_IF) Or enc_IF = "" Then
            MsgBox "Por favor, selecione um registro.", vbExclamation, "Abrir arquivo word"
            Cancel = True
    Else
            If Len(Dir(strLocal, vbArchive) & "") = 0 Then
                    If MsgBox("Arquivo não encontrado.  Deseja criar um novo ?", vbQuestion + vbYesNo, "Confirmação") = vbYes Then
                            'Abre o arquivo do Word modelo
                            wdApl.Documents.Open FileName:=CurrentProject.Path & "\SinteseEncaminhamento\ArquivoModelo.docx" ',passwordDocument:="SenhaDoDocumento"
                            With wdApl
                            
                            'Aponte os campos aos referidos indicadores
                            .ActiveDocument.Bookmarks("Cras").Select: .Selection.Text = Nz(Me!enc_IF)
                            .ActiveDocument.Bookmarks("IF").Select: .Selection.Text = Nz(Me!enc_IF)
                            .ActiveDocument.Bookmarks("NomeResp").Select: .Selection.Text = Nz(Me!enc_NomeCompRespIF)
                            
                            'Salva o documento preenchido no mesmo local do aplicativo
                            .ActiveDocument.SaveAs strLocal ', Password:="123"
                            
                            'Fecha o documento
                            .ActiveDocument.Close
                            
                            'Fecha o Word
                            .Quit
                            End With
                            'Limpa a memória
                            Set wdApl = Nothing
                            
                            'Abre o documento preechido para visualização e impressão
                            Application.FollowHyperlink strLocal
                            
                    End If
            Else
            'se existe abre o arquivo
            Application.FollowHyperlink strLocal, , False
            End If
            
    End If

    Conteúdo patrocinado

    [Resolvido]Criar arquivo Word com imagem Empty Re: [Resolvido]Criar arquivo Word com imagem

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 21/9/2019, 16:48