Ir ao conteúdo
  • Cadastre-se

WJSRamos

Membro Júnior
  • Posts

    5
  • Cadastrado em

  • Última visita

Reputação

0
  1. Rapaz, funcionou perfeitamente, muito obrigado mesmo!
  2. Boa tarde Srs. Estou criando um banco de dados no Excel integrado com documentos e diversos tipos de arquivos salvos em diretórios do computador. Ele tem UserForm que lista em uma ListBox todos os arquivos e pastas do cliente, e lista o caminho da pasta selecionada. Preciso fazer um botão que quando ativado, abra o arquivo, independente de sua extensão. Por exemplo tenho o seguinte caminho e quero que ao clicar o sistema abra o mesmo: C:\Users\TOSHIBA\Desktop\C.I.ematur\Wellington Jackson de Souza Ramos [2]\1-Documentos Pessoais\Novo Documento de Texto.txt Procurei na internet porém achei apenas como abrir tipos separados de arquivos (XLS, WORD, PDF, TXT, JPG), mas preciso de um geral, pois ele trabalhará em conjunto com outros programas que geram arquivos com extensões diferenciadas, tipo KML, CSV, DWG, BAK entre outros. Agradeço desde já...
  3. Segue anexo a solução. Foi inserido a formula =SOMASE($A$3:$A$25798;E3;$B$3:$B$25798) na primeira célula da tabela 2 e copiada para as demais, assim ele verifica o nome e soma os valor destes nomes. Por favor, verifique lá se é isto mesmo. Calculo da Moda.xls
  4. Boa tarde Srs. Estou criando um gerador de documentos, que exporta todos os dados para word. Quanto ao documento já consegui fazer com que o vba o crie automaticamente. Mas preciso fazer um código que identifique todas as colunas da planilha que tem a palavra "OK" e então, copie seus dados para outra planilha chamada "Simples" e gere este word com base neles, então ela continua a busca, copie os dados para este mesmo local sobrescrevendo o anterior já colado, gere um novo word e continue assim por diante. A Coluna que pode conter o "OK" é a (O) e os dados estão nas (S, T, U, V, W - Planilha "Complet"). Já o local destino para a cópia são: Na Complet copia "S" para a Simples.Range("OK_Ass") Na Complet copia "T" para a Simples.Range("OK_CPF") Na Complet copia "U" para a Simples.Range("OK_Nome") Na Complet copia "V" para a Simples.Range("OK_Qualifica") Na Complet copia "W" para a Simples.Range("OK_Identifica") Segue o código que criei até o momento: Sub EmitirRequerimento()Dim applWord As ObjectDim docWord As ObjectDim ws As WorksheetDim Titulo1 As VariantDim Dono As VariantDim EuNome As VariantDim Classi As VariantDim Data As VariantDim Ass As VariantDim CPFAss As VariantDim Dk As VariantDim MkDk As VariantDim GrupoRequerimento As VariantDim AgoraNow As VariantDim CidEmit As VariantSet ws = ActiveWorkbook.Sheets("Simples")'|||||||||||||||||||||||||||||I|||||||||||||||||||||||||||||'|||||||||||||||||||||||||||||N|||||||||||||||||||||||||||||'|||||||||||||||||||||||||||||I|||||||||||||||||||||||||||||'|||||||||||||||||||||||||||||C|||||||||||||||||||||||||||||'|||||||||||||||||||||||||||||I|||||||||||||||||||||||||||||'|||||||||||||||||||||||||||||O|||||||||||||||||||||||||||||GrupoRequerimento = Complet.Range("L2")Titulo1 = ws.Range("b1").TextDono = ws.Range("b2").TextEuNome = ws.Range("B3").TextClassi = ws.Range("B4").TextData = ws.Range("B5").TextAss = ws.Range("B7").TextCPFAss = ws.Range("B8").TextAgoraNow = ws.Range("D1").TextMkDk = Environ("USERPROFILE") & "\Desktop\AutoCM • Relatórios (2.0)\Z-Requerimento\" & GrupoRequerimento & "\"Dk = MkDk & Ass & " [" & AgoraNow & "].docx"On Error Resume NextMkDir MkDkSet applWord = GetObject(, "Word.Application")If Err.Number <> 0 ThenSet applWord = CreateObject("Word.Application")End IfOn Error GoTo 0applWord.Visible = FalseapplWord.WindowState = 1Set docWord = applWord.Documents.AdddocWord.SaveAs Filename:=DkWith docWord.PageSetup.Orientation = wdOrientPortrait.TopMargin = applWord.InchesToPoints(0.5).BottomMargin = applWord.InchesToPoints(0.5).LeftMargin = applWord.InchesToPoints(0.65).RightMargin = applWord.InchesToPoints(0.65).PageWidth = applWord.InchesToPoints(8).PageHeight = applWord.InchesToPoints(11).Gutter = applWord.InchesToPoints(0.25).GutterPos = wdGutterPosLeftEnd WithWith docWordWith .Styles(-1) 'Titulo.Font.Name = "Times New Roman".Font.Size = 12.Font.Color = Black.Font.Bold = True.ParagraphFormat.Alignment = 0.ParagraphFormat.LineSpacingRule = 0End WithWith .Styles(-2) 'Qualificação.Font.Name = "TimesNewRoman".Font.Size = 12.Font.Color = Black.Font.Bold = False.ParagraphFormat.Alignment = 3.ParagraphFormat.LineSpacingRule = 0End WithWith .Styles(-3) 'Oficial e suas descrições.Font.Name = "TimesNewRoman".Font.Size = 12.Font.Color = Black.Font.Bold = True.ParagraphFormat.Alignment = 0.ParagraphFormat.LineSpacingRule = 1End WithWith .Styles(-4) 'Nome em negrito.Font.Name = "TimesNewRoman".Font.Size = 12.Font.Color = Black.Font.Bold = True.ParagraphFormat.Alignment = 3End WithWith .Styles(-5) 'Documentos anexos.Font.Name = "Times New Roman".Font.Size = 12.Font.Color = Black.Font.Bold = False.Font.Italic = False.ParagraphFormat.Alignment = 0.ParagraphFormat.LineSpacingRule = 2End WithWith .Styles(-6) 'Descrição antes da data e emissão.Font.Name = "Times New Roman".Font.Size = 12.Font.Color = Black.Font.Bold = False.Font.Italic = False.ParagraphFormat.Alignment = 1End WithWith .Styles(-7) 'Assinatura.Font.Name = "Times New Roman".Font.Size = 12.Font.Color = Black.Font.Bold = True.Font.Italic = False.ParagraphFormat.Alignment = 1End With'|||||||||||||||||||||||||||||Começa a Escrever no Word|||||||||||||||||||||||||||||.Range(0).Style = .Styles(-1).Content.InsertAfter Titulo1.Content.InsertParagraphAfter.Content.InsertParagraphAfter .Range(.Characters.Count - 2).Style = .Styles(-3).Content.InsertAfter "Excelentíssimo Senhor:" & Chr(11) & Dono & Chr(11) & "Oficial.".Content.InsertParagraphAfter.Content.InsertParagraphAfter.Range(.Characters.Count - 2).Style = .Styles(-4).Content.InsertAfter vbTab & EuNome.Paragraphs.Last.Style = .Styles(-2).Content.InsertAfter Classi.Content.InsertParagraphAfter.Paragraphs.Last.Style = .Styles(-5).Content.InsertAfter _vbTab + "• Mapa e Memorial Descritivo do Imóvel;" & Chr$(11) & _vbTab + "• Anotação de Responsabilidade Técnica - ART;" & Chr$(11) & _vbTab + "• Certificado de Cadastro de Imóvel Rural - CCIR;" & Chr$(11) & _vbTab + "• Número do Imóvel na Receita Federal - NIRF;" & Chr$(11) & _vbTab + "• Registro no CAR-PR- CADASTRO AMBIENTAL RURAL;" & Chr$(11) & _vbTab + "• Declaração de Anuência dos confinantes.".Content.InsertParagraphAfter.Content.InsertParagraphAfter.Paragraphs.Last.Style = .Styles(-6).Content.InsertAfter _"Nestes Termos." & Chr$(11) & _"Pede e aguarda, deferimento.".Content.InsertParagraphAfter.Content.InsertParagraphAfter.Paragraphs.Last.Style = .Styles(-6).Content.InsertAfter Data.Content.InsertParagraphAfter.Content.InsertParagraphAfter.Content.InsertParagraphAfter.Paragraphs.Last.Style = .Styles(-7).Content.InsertAfter _"__________________________________________" & Chr$(11) & _Ass & Chr$(11) & _CPFAssdocWord.Close SaveChanges:=-1applWord.QuitSet docWord = NothingSet applWord = NothingEnd WithMsgBox "Requerimento de " & Ass & " gerado com sucesso, salvo automaticamente na pasta " & GrupoRequerimento & " em:" & Chr$(13) & Chr$(13) & _MkDk, vbInformation + vbOKOnly, "Gerador de Requerimento - Auto-CM 1.0"'|||||||||||||||||||||||||||||F|||||||||||||||||||||||||||||'|||||||||||||||||||||||||||||I|||||||||||||||||||||||||||||'|||||||||||||||||||||||||||||M||||||||||||||||||||||||||||| Shell "C:\WINDOWS\explorer.exe """ & MkDk, vbMaximizedFocussair:End Sub
  5. Bom dia MooM, Por favor, verifique se este código deu certo para você, alterei algumas coisas aqui para ele funcionar: -------------------------------------------------- Sub PDF() Dim Nome As String Dim SDate As String Dim MyLocal As String Nome_Arq = MyLocal & "SI FCL --- " & Nome & " --- " & Export & " --- " & Agent & " --- " & PO & " --- " & Day(Now) & _ "-" & Month(Now) & "-" & Year(Now) & ".pdf" MyLocal = "G:\INTERNACIONAL\SI -MODELO DE INSTRUÇÃO DE EMBARQUE\MODELO NOVO SI MARÍTIMA FCL - 2015\PDF\" Nome = Range("AB12").Value Export = Range("T12").Value Agent = Range("AB10").Value PO = Range("AB6").Value SDate = Now If MsgBox("Gerar PDF", vbYesNo) = vbYes Then Sheets("SEA FCL - SHIPPING INSTRUCTIONS").Select Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Nome_Arq, _ Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _ OpenAfterPublish:=True Application.DisplayAlerts = False Else Application.DisplayAlerts = False End If End Sub ------------------------------------------

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