Jvitorino1007

@Basole achei esse código, como poderia inserir no outro codigo? Tentei de algumas formas mas não consegui

Dim wb As Workbook

Dim prtvw As ProtectedViewWindow

Set wb = prtvw.Edit()

ou 

Sub wkBooks()

Dim wbProtected As Workbook

If Application.ProtectedViewWindows.Count > 0 Then

Set wbProtected = Application.ProtectedViewWindows(1).Workbook

End If

Boa tarde, não se é possível realizar esse código. Tenho uma código que gera um documento no Word que pega as informações das Textbox preenchida e com um arquivo modelo ele preenche os dados. Só que tenho que desabilitar manualmente o modo de exibição protegido, teria algum código que faça isso de modo automático? Porque esse arquivo será disponibilizado para vários usuários.

Private Sub CommandButton5_Click()
Dim word
Dim doc
Dim StrFile As String, strFolder As String
Set word = CreateObject("Word.Application")
word.Visible = True

Set doc = word.Documents.Add(ThisWorkbook.Path & "\Carta_Padrão.doc")
With doc
'*Dados fornecedor
.FormFields("dia").Range = dia.Text
.FormFields("mes").Range = mes.Text
.FormFields("ano").Range = ano.Text
.FormFields("Distribuidora").Range = Distribuidora.Text
.FormFields("Subestação").Range = Subestação.Text
.FormFields("Distribuidora1").Range = Distribuidora1.Text
.FormFields("numero").Range = numero.Text
.FormFields("BAY").Range = BAY.Text
.FormFields("se1").Range = se1.Text
.FormFields("codigo").Range = codigo.Text
.FormFields("Distribuidora2").Range = Distribuidora2.Text

.FormFields("dias").Range = dias.Text
.FormFields("meses").Range = meses.Text
.FormFields("anos").Range = anos.Text
.FormFields("anoatualizado").Range = anoatualizado.Text


.SaveAs (ThisWorkbook.Path & "\Carta_de_pré_aprovação - " & Subestação & "_" & BAY & ".docx ")
 
word.Quit

Set word = Nothing
Set doc = Nothing


End With
MsgBox "Dados Gerados com Sucesso", vbInformation, "INFORMAÇÃO"

Unload Me
End Sub

 Gera o erro '5981' com o modo de exibição protegido, todos selecionados.

Agradeço desde já.

@Basole boa tarde, na verdade seria o modo protegido do Word, quando habilitado não permite o preenchimendo do arquivo gerando o erro '5981', tentei alguns códigos mas sem sucesso. Quando desabilitado funciona normalmente.

@Basole Boa tarde, funcionou perfeitamente. Tem um porém, os computadores que tem o modo protegido não deixa o documento do Word ser aberto para preencher, teria algum código para fazer essa tarefa sozinho? Desde já agradeço pela ajuda

Bom dia, tenho um programa no VBA que gera um arquivo no Word, e no momento ele está salvando em uma pasta especifica, no caso precisa que esse documento fosse salvo na mesma pasta em que a macro está salva . Alguém poderia me ajudar por gentileza? Já tentei algumas coisa mas nada deu certo.

Dim word
Dim doc
Dim StrFile As String, strFolder As String
Set word = CreateObject("Word.Application")
word.Visible = True

Set doc = word.Documents.Add(ThisWorkbook.Path & "\Carta_Padrão.doc")
With doc
'*Dados fornecedor
.FormFields("dia").Range = dia.Text
.FormFields("mes").Range = mes.Text
.FormFields("ano").Range = ano.Text
.FormFields("Distribuidora").Range = Distribuidora.Text
.FormFields("Subestação").Range = Subestação.Text
.FormFields("Distribuidora1").Range = Distribuidora1.Text
.FormFields("numero").Range = numero.Text
.FormFields("BAY").Range = BAY.Text
.FormFields("se1").Range = se1.Text
.FormFields("codigo").Range = codigo.Text
.FormFields("Distribuidora2").Range = Distribuidora2.Text

.FormFields("dias").Range = dias.Text
.FormFields("meses").Range = meses.Text
.FormFields("anos").Range = anos.Text
.FormFields("anoatualizado").Range = anoatualizado.Text

.SaveAs ("Z:\TOPE\23-Sistemas_de_Medição\_Medição de Faturamento\Concessionárias\TESTE\Carta_de_pré_aprovação - " & Subestação & "_" & BAY & ".docx ")

word.Quit

Set word = Nothing
Set doc = Nothing

End With
MsgBox "Dados Gerados com Sucesso", vbInformation, "INFORMAÇÃO"

Unload Me

@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

@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 @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.

@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 amigo também precisava aumentar a figura, tentei alguns códigos mas não deram ressultados.

@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

@Basole @Basole vou enviar,

teste.xls

@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 Bom dia amigo, vou tentar aqui  muito obrigado novamente.Obrigado mesmo

@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 Vou tentar aqui, muito obrigado novamente

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

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 Vou tentar aqui amigo, muito obrigado desde já.

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

@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

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!!!!

@Eder Neumann ok Eder, vou tentar aqui obrigado!

11 minutos atrás, Jvitorino1007 disse:

@Eder Neumann ok Eder, vou tentar aqui obrigado!

Não deu certo Eder

@Eder Neumann Desculpa amigo não entendi

Bom dia, tenho esse código abaixo e queria pegar o valor da célula e colocar em um local especifico no Word mas não estou conseguindo. Alguém por gentileza poderia me ajudar por favor? Desde já agradeço.

Sub Criar_Doc()
    Dim objWord As Object
    Dim objDoc As Object
    Dim i As Integer
    Dim strValueA As String, strValueB As String, strValueC As String, strValueD As String

    On Error GoTo erro

    Set objWord = CreateObject("Word.Application") '   define o objeto
    objWord.Visible = True
    Set objDoc = objWord.Documents.Add    ' cria um novo doc

    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        With Sheets("Plan1")
            objDoc.Activate
            strValueA = .Cells(i, 1): strValueB = .Cells(i, 2): strValueC = .Cells(i, 3): strValueD = .Cells(i, 4) '  define os valores a string
            objWord.Selection.TypeText Text:=strValueA & "      " & strValueB & "       " & strValueC & "              " & strValueD & ""
            objWord.Selection.TypeParagraph    ' move p/ prox linha
        End With
    Next i

    If Dir(Environ("USERPROFILE") & "\Desktop\MeuNovoDoc.doc") <> "" Then    ' verif se ja existe o doc c/ o mesmo nome..
        Kill Environ("USERPROFILE") & "\Desktop\MeuNovoDoc.doc"                    ' ...se existir exclui
    End If
    objDoc.SaveAs (Environ("USERPROFILE") & "\Desktop\MeuNovoDoc.doc")   '   * Salva o documento na pasta  "Desktop"
    MsgBox "O novo domumento foi salvo em: " & Environ("USERPROFILE") & "\Desktop\MeuNovoDoc.doc", 0, "Sucesso"    ' msg
    objWord.Quit       ' fecha o doc
    Set objWord = Nothing
    Exit Sub
erro:     MsgBox Err.Description, vbCritical, "Atenção!!!"

End Sub

@Basole Bom dia , como faço para vincular o que pego de valor de uma célula da Plan1 e colocar no local especifico no Word?

Poderia ajudar por favor?

Em 06/08/2019 às 17:19, osvaldomp disse:

Sim, é possível

Não sou preguiçoso não viu,só tive dificuldade pra fazer. Já consegui fazer o que queria.

Em 06/08/2019 às 17:19, osvaldomp disse:

Sim, é possível

Mas Obrigado!

Em 03/08/2019 às 12:27, Jvitorino1007 disse:

@osvaldomp muito obrigado

Boa noite amigo, mas eu coloco junto com o botão que limpa? Se sim em qual parte seria?

adicionado 1 minuto depois

Muito obrigado pela ajuda amigo.

Boa tarde, esse código apaga todos os campos, é possível apagar células especificas e apagar o que foi preenchido no TextBox e ComboBox do VBA?

2 horas atrás, Patropi disse:

@Jvitorino1007

 

Como a resposta fi útil, faltou clicar em curtir nas resposta do Osvaldo e marcar o tópico como Resolvido.

Na minha assinatura tem um link para um instrução de como proceder.

 

[]s

@osvaldomp muito obrigado

16 horas atrás, osvaldomp disse:

 

Experimente:

 

Me.Image1.Picture = LoadPicture("")

 

Boa noite amigo, mas eu coloco junto com o botão que limpa? Se sim em qual parte seria?

3 horas atrás, osvaldomp disse:

Private Sub CommandButton1_Click()
 Dim objeto As Control
  For Each objeto In Me.Controls
  If TypeName(objeto) = "TextBox" Or TypeName(objeto) = "ComboBox" Then
  objeto.Text = ""
  End If
  Next objeto
  Me.Image1.Picture = LoadPicture("")
End Sub

Muito obrigado pela ajuda amigo.

2 horas atrás, osvaldomp disse:

 

Experimente:

 

Me.Image1.Picture = LoadPicture("")

 

Boa noite amigo, mas eu coloco junto com o botão que limpa? Se sim em qual parte seria?