Ir ao conteúdo

Basole

Membro Pleno
 Perfil  Explorar Conteúdo

  • Posts

    2.009

  • Cadastrado em

 Tipo de conteúdo 

Tudo que Basole postou

  1. Basole

    Visual Basic Codigo para vba excel

    Basole respondeu ao tópico de patrickYC em Programação - outros

    Anexe o seu arquivo ou se tiver restricoes em compartilhar, faca um modelo bem proximo do original, inserindo alguns dados ficticios, para que o pessoal possa entender melhor a sua demanda.
  2. Basole
    Segue sugestão de acordo com as informações passadas Sub AbrirPlanDeterminadaPasta() Dim wb As Workbook Dim nPlan As Single Dim strPath As String Dim strFile As String strPath = "C:\temp\" ' * ALTERE O CAMINHO DA PASTA * nPlan = Excel.Application.InputBox(" Insira apenas numeros ", _ "Insira o Nº de Patrimônio", Type:=1) If Not VBA.IsNumeric(nPlan) Then Exit Sub strFile = VBA.Dir(strPath & nPlan & ".xls*", VBA.vbArchive) If strFile <> "" Then Set wb = Excel.Workbooks.Open(strPath & strFile) Else MsgBox nPlan & ": ! Arquivo nao encontrado! Verifique! ", _ vbCritical, "Nao Encontrado" Exit Sub End If wb.Activate wb.Worksheets(1).Activate End Sub
  3. Basole
    @Jvitorino1007 é necessário mais informacões sobre o tipo de bloqueio tem determinado arquivo. Através de uma instrução vba é possivel alterar os atributos de um arquivo. Mas isso vai contra a politica da empresa. Sugiro consultar o departamento de TI, quanto a essas restricões.
  4. Basole
    @Jvitorino1007 Qual o código que usa para gerar o novo documento?
  5. Basole
    Altere esta linha desta forma: .SaveAs (ThisWorkbook.Path & "\Carta_de_pré_aprovação - " & Subestação & "_" & BAY & ".docx ")
  6. Basole
    @Eri França na coluna F é necessário inserir os enderecos das imagens que deseja que apareca ao selecionar BUSCA AVANÇADA COLEÇÃO.zip
  7. Basole
    Para mim, nao apresentou nenhum erro, nesta macro em questao.
  8. Basole
    Para entender melhor a sua demanda, envie o arquivo ou um modelo bem próximo do original, com alguns dados fictícios
  9. Basole
    @Purgg voce esqueceu de colocar um ( s ) no nome da variável d_Gastos. lSQL = "Insert into Gastos VALUES ('" & n_Controle & "','" & Valor & "','" & d_Gastos & "','" & Observacoes & "');"
  10. Basole
    Cole o código abaixo no modulo de EstaPasta_de_trabalho: Private Sub Workbook_Open() Dim WS As Worksheet For Each WS In ThisWorkbook.Worksheets If WS.Name = VBA.Year(VBA.Date - 360) Then WS.Name = VBA.Year(VBA.Date) End If Next WS End Sub
  11. Basole
    @Guilherme Benvenuto no seu arquivo, tem várias macros, qual ou quais estão apresentando os erros citados ?
  12. Basole
    @Pablo Terra para entender melhor a sua demanda, envie o arquivo ou um modelo bem próximo do original demonstrando manualmente o resultado esperado.
  13. Basole
    @Olua sem saber as alterações que deseja, fica difícil alguém querer lhe ajudar
  14. Basole
    @perinazzoo experimente colocar as aspas no comando, como caracteres: oShell.Run "cmd.exe /c start /wait \\ipdoservidor\Suporte\Programas\a\freeav\setup.exe -s -sp " & Chr(34) & quiet & Chr(34) ou assim... oShell.Run "cmd.exe /c start /wait \\ipdoservidor\Suporte\Programas\a\freeav\setup.exe -s -sp ""quiet"""
  15. Basole
    @iS2Hardware através desta macro, essa tarefa fica mais simples. Sub ReplicarLinhas() QdtLinhasAReplicar = 3 With ActiveSheet For i = .Cells(.Rows.Count, 1).End(xlUp).Row To 2 Step -1 .Rows(i).Copy .Rows(i).Resize(QdtLinhasAReplicar).Insert Next End With Excel.Application.CutCopyMode = False End Sub
  16. Basole
    @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
  17. Basole
    @Rafael Ludovico experimente desta foram: .HTMLBody = "<HTML>" & vbNewLine & _ "<BODY style=font-size:12pt;font-family:Calibri> " & vbNewLine & _ "<P>" & Range("f5").Value & " boa tarde</P>" & vbNewLine & _ "<P></P> " & vbNewLine & _ "<P></P> " & vbNewLine & _ "<P>Segue o relatório semanal de Performance da equipe do " & Range("d5").Value & ".</P>" & vbNewLine & _ "<P>Atenciosamente,</P>" & vbNewLine & _ "</BODY>" & vbNewLine & _ "</HTML>"
  18. Basole
    Abra o aplicativo Outlook no seu PC e siga as instrucões do assistente de configuracão. .
  19. Basole
    @Cleomirfl experimente configurar sua conta de e-mail, no aplicativo Outlook.
  20. Basole
    @aprendiz_vba de nada obrigado pelos elogios, eu também sou sempre um aprendiz
  21. Basole
    @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)
  22. Basole
    @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
  23. Basole
    @aprendiz_vba fiz os ajustes no seu codigo, veja se é isso: Public Sub Importar() Dim Ficheiro As String Dim fd As FileDialog Dim strPath As String Dim xFile As String Dim xFiles As New Collection Dim i As Long Set fd = Application.FileDialog(msoFileDialogFolderPicker) fd.AllowMultiSelect = False fd.Title = "Selecione a Pasta que contem o arquivos TXT" If fd.Show = -1 Then strPath = fd.SelectedItems(1) End If If strPath = "" Then Exit Sub If VBA.Right(strPath, 1) <> "\" Then strPath = strPath & "\" xFile = VBA.Dir(strPath & "*.txt") If xFile = "" Then MsgBox "Nenhum arquivo encontrado !", 64, "Atencao" Exit Sub End If Do While xFile <> "" xFiles.Add xFile, xFile xFile = VBA.Dir() Loop If xFiles.Count > 0 Then For i = 1 To xFiles.Count Ficheiro = strPath & xFiles.Item(i) Dim LR As Long Dim c As Long Dim sColName As String: sColName = "COL " With ThisWorkbook.ActiveSheet ' Adiciona nomes nas colunas For c = 1 To 5 .Cells(1, c).Value = sColName & c .Cells(1, c).Font.Bold = True .Cells(1, c).HorizontalAlignment = xlCenter Next c LR = .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Row Open Ficheiro For Input As #1 Dim S As String Do Until EOF(1) Line Input #1, S 'FILIAL: If VBA.InStr(S, "abcdef") = 26 Then .Cells(LR, "e").NumberFormat = "@" .Cells(LR, "e") = VBA.Mid(S, 10, 4) End If 'DADOS: If VBA.InStr(S, "5000") = 1 Then .Cells(LR, "A").Value = VBA.Mid(S, 1, 1) .Cells(LR, "B").Value = VBA.Mid(S, 21, 7) .Cells(LR, "C").Value = VBA.Mid(S, 349, 45) .Cells(LR, "D").NumberFormat = "#,##0.00" .Cells(LR, "D").Value = VBA.Mid(S, 6, 5) LR = .Cells(.Rows.Count, "a").End(xlUp).Offset(1).Row .Cells(LR, "e").NumberFormat = "@" .Cells(LR, "e").Value = .Cells(LR - 1, "e").Value End If Loop If Cells(LR, "A").Value = "" Then .Cells(LR, "E").NumberFormat = "General" .Cells(LR, "E").Value = "" End If Close #1 End With Next ThisWorkbook.ActiveSheet.Range("A:E").Columns.AutoFit End If End Sub
  24. Basole
    @Douglas ianes veja este exemplo: Auto_Destroi.zip
  25. Basole
    Veja se e isso: Sub Copy_ActiveSheet_1() 'Working in Excel 97-2016 Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim TempFilePath As String Dim TempFileName As String With Application .ScreenUpdating = False .EnableEvents = False End With Set Sourcewb = ActiveWorkbook 'Copy the sheet to a new workbook ActiveSheet.Copy Set Destwb = ActiveWorkbook FileExtStr = ".xlsx": FileFormatNum = 51 'Save the new workbook and close it TempFilePath = ThisWorkbook.Path & "\" TempFileName = VBA.Left(ThisWorkbook.Name, (VBA.InStrRev(ThisWorkbook.Name, ".", -1, VBA.vbTextCompare) - 1)) With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum .Close SaveChanges:=False End With MsgBox "You can find the new file in " & TempFilePath With Application .ScreenUpdating = True .EnableEvents = True End With 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

Mais

×
×
  • Criar novo...

LANÇAMENTO!

eletronica2025-popup.jpg


CLIQUE AQUI E BAIXE AGORA MESMO!