Ir ao conteúdo
  • Cadastre-se

Muca Costa

Membros Plenos
  • Total de itens

    108
  • Registro em

  • Última visita

  • Qualificações

    0%

Reputação

33

Sobre Muca Costa

  • Data de Nascimento 24 de agosto

Informações gerais

  • Cidade e Estado
    São José dos Campos/SP
  • Sexo
    Masculino
  1. você tem que excluir esse passo Selection.ClearContents na Macro1
  2. Aqui tem um passo a passo para criar formulários: https://www.youtube.com/watch?v=kmD9wMyvxY4
  3. Sub ExecutaMacros() Call Macro1 Call Macro2 Call Macro3 End Sub Sub Macro1() Sheets("Planilha1").Select Range("B1").Select Range("B1") = "Executou Macro 1" End Sub Sub Macro2() Sheets("Planilha2").Select Range("B1").Select Range("B1") = "Executou Macro 2" End Sub Sub Macro3() Sheets("Planilha3").Select Range("B1").Select Range("B1") = "Executou Macro 3" End Sub
  4. É só descompactar com WinRAR. A planilha proposta tem macro (xlsm)
  5. Seu código com algumas mudanças: Aqui funcionou... Sub Grava() Dim Guia As String 'Texto obrigatorio If Range("B2").Value = "" Then MsgBox "Nome é Obrigatório" Else 'Renomeia e salva nova aba Sheets("NOVO").Copy After:=Sheets(Sheets.Count) ActiveSheet.Name = Sheets("NOVO").[B2] Guia = ActiveSheet.Name With Sheets("NOVO").[B2] = [B2] 'Cola pasta clientes Range("B2").Select Selection.Copy Sheets("CLIENTES").Select Range("B3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("NOVO").Select Range("B4").Select Application.CutCopyMode = False Selection.Copy Sheets("CLIENTES").Select Range("C3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("F3").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "=ROW()" Range("A3").Select ActiveCell.FormulaR1C1 = "=R[1]C+1" Rows("3:3").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 'Limpa tudo Sheets("NOVO").Select Range("B2").Select Selection.ClearContents Range("B4").Select Selection.ClearContents Sheets("NOVO").Select Range("B2").Select Selection.ClearContents Range("B4").Select Selection.ClearContents Range("A8:D48").Select Selection.ClearContents Range("F8:G48").Select Selection.ClearContents Range("G8").Select Sheets("CLIENTES").Select Range("D4").Select ActiveCell.FormulaR1C1 = "VER" Range("D4").Select ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _ Guia & "!A1", TextToDisplay:="VER" Sheets("NOVO").Select End With End If End Sub
  6. Private Sub Worksheet_Change(ByVal Target As Range) Dim Guia As String Guia = ActiveSheet.Name If Target.Column <> 3 Then Exit Sub If Target.Offset(, 0).Value >= 1 Then Atualiza End If Sheets(Guia).Select End Sub Tente assim...
  7. EM UM MÓDULO: Sub Atualiza() Sheets("TEMAS").Select Range("B1").Select Columns("B:B").Select Selection.Copy Columns("C:C").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False End Sub NA GUIA "2021": Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 3 Then Exit Sub If Target.Offset(, 0).Value >= 1 Then Atualiza End If End Sub
  8. Sub Duplica() Dim P As String With ActiveSheet P = .Cells(.Rows.Count, "A").End(xlUp).Row End With Range("A" & P).Select Selection.Copy Range("A" & P + 1).Select ActiveSheet.Paste Range("A" & P + 2).Select ActiveSheet.Paste Application.CutCopyMode = False End Sub
  9. 3° Como eu coloco os dizeres no começo do corpo do email? Os dizeres Prezados" -> pula duas linhas -> xxxxxxxx Podem ser incluídos junto com a tabela em F1 e F2 por exemplo De: ActiveSheet.Range("F3:I31").Select Para: ActiveSheet.Range("F1:I31").Select
  10. Corrigindo: DE: Email.HTMLBody = sh.Range("F3:I31") & "<img border='0' src='temp.gif' width='1267' height='460'>" PARA: Email.HTMLBody = "<img border='0' src='Carregamento.gif' width='1267' height='460'>"
  11. Sub MacroEmail() Dim sh As Worksheet grafico_para_imagem On Error Resume Next Set sh = Sheets("Tabela dinamica - Volume") Set objeto_outlook = CreateObject("Outlook.Application") Set Email = objeto_outlook.CreateItem(0) Email.Display Email.CC = "" 'Informe Email.To = "" 'Informe Email.Subject = "Relatório de expedição rodoviário" ActiveSheet.Range("F3:I31").Select Selection.Copy Email.Attachments.Add ThisWorkbook.Path & "\Carregamento.gif", olByReference, 1 Email.HTMLBody = sh.Range("F3:I31") & "<img border='0' src='temp.gif' width='1267' height='460'>" Email.Display Application.SendKeys "{TAB 4}" Application.SendKeys "^v" End Sub Sub grafico_para_imagem() Set Gráfico = Sheets("Tabela dinamica - Volume").ChartObjects(1).Chart ArquivoGIF = ThisWorkbook.Path & "\Carregamento.gif" Gráfico.Export Filename:=ArquivoGIF, FilterName:="GIF" End Sub
  12. Para podermos lhe ajudar, seria melhor você anexar sua planilha.
  13. Outra sugestão. Listar células filtradas.rar
  14. Caro Dinei San, desculpe, a minha intenção é lhe ajudar. Porém a planilha que proponho tem macro e está na extensão xlsm. A solução proposta é em Excel, é só você extraí-lo. Norma do Fórum: Tipo de arquivos permitidos log, txt, ini, zip, zipx, rar, 7z, jpg, png, gif, doc, docx, xls, xlsx, pdf, ppt, pps, pptx, bmp, csv, tiff, xml, jpeg Tamanho total do arquivo 4,88MB
  15. https://www.win-rar.com/open-rar-file.html?&L=9

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

Aprenda a ler resistores e capacitores

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!