Word Quebra de página no documento Word

Jvitorino1007 · 10 de setembro de 2019

Bom dia, alguém poderia me ajudar por favor?

Estou gerando um documento em Word atráves do VBA excel com textos e imagens, só que precisava que essa imagem fosse salva em outra página e não estou conseguindo fazer...estou usando esse código "Selection.InsertBreak Type:=wdPageBreak" mas fica dando erro 461.

Por gentileza laguém poderia me auxliar por favor?

Obrigado!!!!

Basole · 10 de setembro de 2019

@Jvitorino1007 Envie o codigo completo que esta utilizando..

Jvitorino1007 · 10 de setembro de 2019

@Basole

Private Sub CommandButton1_Click()
Dim Word As Object

Dim documento As Object
Dim selection As Document

Dim oImage As Shape

Set Word = CreateObject("Word.Application")

Word.Visible = True

Set documento = Word.Documents.Add(ThisWorkbook.Path & "\Test.docx")

Dim docativo
Set docativo = documento
docativo.InlineShapes.AddPicture Filename:=nome, LinkToFile:=False, SaveWithDocument:=True

End Sub

Basole · 10 de setembro de 2019

Segue codigo com as alteracoes:

Private Sub CommandButton1_Click()
Dim Word As Object

Dim documento As Object
Dim selection As Document
Dim oImage As Shape

Set Word = CreateObject("Word.Application")

Word.Visible = True

Set documento = Word.Documents.Add(ThisWorkbook.Path & "\Test.docx")

Dim docativo
Set docativo = documento
docativo.InlineShapes.AddPicture Filename:=nome, LinkToFile:=False, SaveWithDocument:=True
Word.selection.InsertBreak Type:=wdPageBreak

End Sub

Jvitorino1007 · 10 de setembro de 2019

@Basole Vou tentar aqui amigo, muito obrigado desde já.

adicionado 15 minutos depois

@Basole amigo deu certo, mas queria que somente a imgem fosse para outra página, o texto está indo junto...

Basole · 10 de setembro de 2019

@Jvitorino1007 veja agora apos esses ajustes :

Private Sub CommandButton1_Click()
    Dim Word As Object
    
    Dim documento As Object
    Dim selection As Document
    Dim oImage As Shape
    Dim nxPara As Paragraph
    Dim s As Word.InlineShape
    
    Set Word = CreateObject("Word.Application")
    
    Word.Visible = True
    
    Set documento = Word.Documents.Add(ThisWorkbook.Path & "\Test.docx")
    
    Dim docativo
    Set docativo = documento
    
    With docativo
      .Range.Paragraphs.Last.Range.InsertParagraphAfter
      Set nxPara = .Paragraphs.Last
      nxPara.Range.InsertBreak Type:=wdPageBreak
      Set s = nxPara.Range.InlineShapes.AddPicture(nome, False, True)
      s.Width = 400
    End With

End Sub

Jvitorino1007 · 10 de setembro de 2019

@Basole Vou tentar aqui, muito obrigado novamente

adicionado 2 minutos depois

3 minutos atrás, Basole disse:

@Jvitorino1007 veja agora apos esses ajustes :


Private Sub CommandButton1_Click()
    Dim Word As Object
    
    Dim documento As Object
    Dim selection As Document
    Dim oImage As Shape
    Dim nxPara As Paragraph
    Dim s As Word.InlineShape
    
    Set Word = CreateObject("Word.Application")
    
    Word.Visible = True
    
    Set documento = Word.Documents.Add(ThisWorkbook.Path & "\Test.docx")
    
    Dim docativo
    Set docativo = documento
    
    With docativo
      .Range.Paragraphs.Last.Range.InsertParagraphAfter
      Set nxPara = .Paragraphs.Last
      nxPara.Range.InsertBreak Type:=wdPageBreak
      Set s = nxPara.Range.InlineShapes.AddPicture(nome, False, True)
      s.Width = 400
    End With

End Sub

@Basole Amigo obrigado mesmo deu certo aqui nota 10 valeu mesmo

adicionado 9 minutos depois

6 minutos atrás, Jvitorino1007 disse:

@Basole Vou tentar aqui, muito obrigado novamente

adicionado 2 minutos depois

@Basole Amigo obrigado mesmo deu certo aqui nota 10 valeu mesmo

@Basole A última dúvida eu tenho que inserir mais uma imagem desse jeito também...e está pulando 3 páginas se eu quiser diminuir como faço..to quebrando a cabeça nisso e você em 1 minuto faz kkk a última ajuda po gentileza se não for pedir demais

Basole · 11 de setembro de 2019

@Jvitorino1007 voce nao especificou, mas suponho que queira inserir outra imagem, na proxima pagina...

* Altere a variavel nome pela da outra imagem

With docativo
      .Range.Paragraphs.Last.Range.InsertParagraphAfter
      Set nxPara = .Paragraphs.Last
      nxPara.Range.InsertBreak Type:=wdPageBreak
      Set s = nxPara.Range.InlineShapes.AddPicture(nome, False, True)
      s.Width = 400
      ' Insere outra imagem em outra pagina
      .Range.Paragraphs.Last.Range.InsertParagraphAfter
      Set nxPara = .Paragraphs.Last
      nxPara.Range.InsertBreak Type:=wdPageBreak
      Set s = nxPara.Range.InlineShapes.AddPicture(nome, False, True)
      s.Width = 400
End With

Jvitorino1007 · 11 de setembro de 2019

@Basole Bom dia amigo, vou tentar aqui muito obrigado novamente.Obrigado mesmo

adicionado 29 minutos depois

@Basole

Private Sub CommandButton1_Click()
Dim Word
Dim documento


Set Word = CreateObject("Word.Application")

Word.Visible = True
Set documento = Word.Documents.Add(ThisWorkbook.Path & "\Test.docx")
Dim docativo
Set docativo = documento


With docativo
      .Range.Paragraphs.Last.Range.InsertParagraphAfter
      Set nxPara = .Paragraphs.Last
      nxPara.Range.InsertBreak Type:=wdPageBreak
      Set s = nxPara.Range.InlineShapes.AddPicture(nome, False, True)
      s.Width = 400
End With
      
With docativo
      .Range.Paragraphs.Last.Range.InsertParagraphAfter
      Set nxPara = .Paragraphs.Last
      nxPara.Range.InsertBreak Type:=wdPageBreak
      Set s = nxPara.Range.InlineShapes.AddPicture(figura, False, True)
      s.Width = 400
 End With
 
With documento

.FormFields("nome").Range = TextBox1.Value
.FormFields("en").Range = TextBox2.Value
End With

End Sub

Private Sub CommandButton3_Click()

Set foto = Sheets("Plan1").ChartObjects("Gráfico 1").Chart
nome = ThisWorkbook.Path & Application.PathSeparator & "temp.gif"
foto.Export Filename:=nome, filtername:="GIF"
Image1.Picture = LoadPicture(nome)

Set foto = Sheets("Plan1").ChartObjects("Gráfico 2").Chart
figura = ThisWorkbook.Path & Application.PathSeparator & "temp.gif"
foto.Export Filename:=nome, filtername:="GIF"
Image2.Picture = LoadPicture(figura)
End Sub

Esse é o código completo que estou usando, ele carrega as duas imagens no userform mas está exportando somente a figura 2.

Basole · 11 de setembro de 2019

@Jvitorino1007 seria o bom se pudesse enviar os arquivos para testar e analisar o seu senário.

.

Jvitorino1007 · 11 de setembro de 2019

@Basole @Basole vou enviar,

adicionado 11 minutos depois

teste.xls

adicionado 39 minutos depois

@Basole amigo consegui reslover essa parte aqui, qual o comando que posso utilizar para movimentar a imagem dentro do word ? Tentei colocar alguns aqui mas não deu certo

Basole · 11 de setembro de 2019

@Jvitorino1007 faltou enviar o arquivo "Test.docx", que esta sendo referenciado no codigo.

@Jvitorino1007 sem esse arquivo nao posso testar. Vamos esperar se algum colega pode lhe ajudar.

Jvitorino1007 · 17 de setembro de 2019

@BasoleBom dia amigo, segue a arquivo em word...seria possivel deixar um título em cima de cada imagem?

Ex: primeira imagem " Curva de seletividade de fase" e segunda imagem " Curva se sletiviadade de neutro"

Test1.docx

Jvitorino1007 · 17 de setembro de 2019

@Basole amigo também precisava aumentar a figura, tentei alguns códigos mas não deram ressultados.

Basole · 18 de setembro de 2019

@Jvitorino1007 segue o ajuste do código de acordo com o cenários dos aquivos enviados:

Private Sub CommandButton1_Click()
Dim Word
Dim documento
Dim nxPara As Paragraph
Dim passo As Integer
         
Set Word = CreateObject("Word.Application")

Word.Visible = True
Set documento = Word.Documents.Add(ThisWorkbook.Path & "\Test1.docx")
Dim docativo
Set docativo = documento

With docativo
        .Range.Paragraphs.Last.Range.InsertParagraphAfter
         Set nxPara = .Paragraphs.Last
         nxPara.Alignment = wdAlignParagraphCenter
         nxPara.Range.Text = "Curva de seletividade de fase"
         .Range.Paragraphs.Last.Range.InsertParagraphAfter
      Set s = nxPara.Range.InlineShapes.AddPicture(nome, False, True)
       
       s.Width = 400  '**** LARGURA DA IMAGEM 1
       s.Height = 200 '**** ALTURA DA IMAGEM 1
      
    For passo = 1 To 5
         ' **** Define os espacos entre as imagens (5 paragrafos abaixo)
      .Range.Paragraphs.Last.Range.InsertParagraphAfter
    Next passo
    
      Set nxPara = .Paragraphs.Last
         nxPara.Range.Text = "Curva se sletiviadade de neutro"
         .Range.Paragraphs.Last.Range.InsertParagraphAfter
    
      Set s = nxPara.Range.InlineShapes.AddPicture(nome, False, True)
      
       s.Width = 400    '**** LARGURA DA IMAGEM 2
       s.Height = 200   '*****ALTURA DA IMAGEM 2
      
 End With
 
With documento

.FormFields("nome").Range = TextBox1.Value
.FormFields("en").Range = TextBox2.Value

End With

End Sub

Jvitorino1007 · 19 de setembro de 2019

@Basole @Basole amigo show de bola cara, nem sei como te agradecer por essas ajudas, esse trabalho é o meu projeto de estágio...ficou 10 com sua ajuda valeu mesmo. Muito obrigado mesmo pela ajuda, acredito que novas dúvidas viram e se puder continuar me dando esse auxilio eu agradeço de coração.

adicionado 18 minutos depois

@Basole Como eu disse, estou tentando colocar em negrito e uma letra maior no "Curva de seletividade de fase e de neutro" mas esta dando erro.

Basole · 19 de setembro de 2019

@Jvitorino1007 tente desta forma:

         nxPara.Range.Font.Name = "TAHOMA"
         nxPara.Range.Font.Size = 13
         nxPara.Range.Font.Italic = True
         nxPara.Range.Font.Bold = True     ' (negrito)

Jvitorino1007 · 25 de setembro de 2019

@Basole Bom dia amigo, funcionou perfeitamente, muito obrigado novamente.

Eu tenho 5 checkbox individuais onde cada um possui 6 campos que são preenchidos com valores e esses valores vão para o word, eu usei esse código:

If ComboBox1.Value <> "" Then
.FormFields("proteção").Range = TextBox55.text
.FormFields("curva").Range = ComboBox1.text
.FormFields("itemp").Range = TextBox7.text
.FormFields("ipk").Range = TextBox8.text
.FormFields("instant").Range = TextBox9.text
.FormFields("tinstant").Range = TextBox10.text
Else

End If

If ComboBox2.Value <> "" Then
.FormFields("proteção").Range = TextBox56.text
.FormFields("curva").Range = ComboBox2.text
.FormFields("itemp").Range = TextBox11.text
.FormFields("ipk").Range = TextBox12.text
.FormFields("instant").Range = TextBox13.text
.FormFields("tinstant").Range = TextBox14.text
 Else
End If

No caso se o comboxbox1 estiver com qualquer valor ele vai mandar os dados para o word e assim com o combobox 2. Mas está dando erro quando tenho informações no combo 1 e 2, não sei qual condição colocar para pegar apenas os valores do combo 1 mesmo que o combo 2, 3, 4 e 5 estiverem preenchidos também e isso para os demais.

Poderia me dar mais uma força por gentileza? Esse trabalho é um projeto de estágio e o meu TCC.

Basole · 25 de setembro de 2019

@Jvitorino1007 bom nao sei como esta toda a rotina, mas voce pode colocar a instrucao de saida Exit Sub, se

atender a respectiva condicão.

Exemplo:

If ComboBox1.Value <> "" Then

        .FormFields("proteção").Range = TextBox55.Text
        .FormFields("curva").Range = ComboBox1.Text
        .FormFields("itemp").Range = TextBox7.Text
        .FormFields("ipk").Range = TextBox8.Text
        .FormFields("instant").Range = TextBox9.Text
        .FormFields("tinstant").Range = TextBox10.Text
         Exit Sub

End If

Jvitorino1007 · 11 de outubro de 2019

@Basole Muito obrigado pela ajuda. Não sei se é possível realizar está tarefa, cada documento gerado possui um nome diferente, e eles são salvos na mesma pasta. No caso precisava enviar esses documentos gerados por e-mail, mas não sei como posso escolher de forma automática, exemplo:

gerou documento 1vai pegar somente o documento 1 para enviar por e-mail usando o outlook, se gerar o documento 2 vai pegar somente 2 e enviar, etc.

Teria como ajudar por gentileza? Consigo só gerar um por vez mais de forma manual e não automática.

Sub MandaEmail()
    
    Dim EnviarPara As String
    Dim Mensagem As String
 
    For i = 1 To 4
        EnviarPara = ThisWorkbook.Sheets(1).Cells(i, 1)
        If EnviarPara <> "" Then
            Mensagem = ThisWorkbook.Sheets(1).Cells(i, 3)
            Envia_Emails EnviarPara, Mensagem
        End If
    Next i
End Sub
Sub Envia_Emails(EnviarPara As String, Mensagem As String)
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    Dim xname As String
    
 
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
 
    With OutlookMail
        .To = "[email protected]"
        .CC = ""
        .BCC = ""
        .Subject = "Pedido enviado"
        .Body = "Mensagem teste"
        .Display ' para envia o email diretamente defina o código  .Send
        .Attachments.Add ("C:\Users\jvitorino\Desktop\Trabalho Emerson\Cartas Geradas\CARTA_DE_PRÉ_APROVAÇÃO - Birigui 2 Guarani.docx")
    End With
 
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
End Sub