-
Posts
2.009 -
Cadastrado em
Tipo de conteúdo
Artigos
Selos
Livros
Cursos
Análises
Fórum
Tudo que Basole postou
-
Access Importar Tabela com ImportarExportarTabela
Basole respondeu ao tópico de BlackM00n_ em Microsoft Office e similares
@BlackM00n_ Poste exemplos de arquivos, para que possamos entender melhor sua demanda. -
PowerPoint Salvar dados do Formulário PowerPoint VBA
Basole respondeu ao tópico de Telma Raizlatina em Microsoft Office e similares
@Telma Raizlatina por favor, anexe um exemplo do seu arquivo, para que possamos entender melhor e ajudar com sua demanda. -
Excel Abrindo arquivos docx e pdf no excel vba
Basole respondeu ao tópico de Fabrizzio Tavares Moretti em Microsoft Office e similares
Pode ser que o caminho do arquivo seja longo e o windows não esta conseguindo ler por completo. Experimente usar esta funcão para "abreviar" o caminho. Use: GetShortPath(SeuCaminho\SeuArquivo) Public Function GetShortPath(path As String) As String Dim fso As Object If fso Is Nothing Then Set fso = CreateObject("Scripting.FileSystemObject") End If If fso.FileExists(path) Then GetShortPath = fso.GetFile(path).ShortPath Exit Function End If If fso.FolderExists(path) Then GetShortPath = fso.GetFolder(path).ShortPath Set fso = Nothing Exit Function End If End Function -
Outro Copiar e Colar de Arquivos Diferentes
Basole respondeu ao tópico de viclizz em Programação - outros
@viclizz somente com imagens dos árquivos fica difícil te ajudar, dando um parecer. Seria bom se pudesse anexar amostra dos arquivos que serão copiados, originais ou exemplos similares. -
Outro Copiar e Colar de Arquivos Diferentes
Basole respondeu ao tópico de viclizz em Programação - outros
De acordo com as informações passadas e as imagens, segue um exemplo *Copie e cole o codigo abaixo em um modulo padrão na sua pasta de trabalho Destino. Sub Copiar_e_Colar_de_Arquivos_Diferentes() 'Por Basole 01/08/19 Dim Filename As String Dim sDia As Single Dim sMes As String Dim xlCopy As Single Dim fldr As FileDialog Dim sItem As String On Error GoTo Erro Excel.Application.ScreenUpdating = False Set fldr = Application.FileDialog(msoFileDialogFolderPicker) With fldr .Title = "Selecione a Pasta que Deseja Copiar os Arquivos" .AllowMultiSelect = False .InitialFileName = Application.DefaultFilePath If .Show <> -1 Then Exit Sub sItem = .SelectedItems(1) End With sMes = InputBox("No formato Numerico dois digitos -> 00", _ "Informe o mes dos repectivos nomes dos arquivos") For sDia = 1 To 31 Filename = VBA.Format(sDia, "00") & VBA.Format(sMes, "00") & VBA.Format(Date, "yy") & _ ".xlsx" If VBA.Dir(sItem & "\" & Filename) <> "" Then Excel.Workbooks.Open Filename:=sItem & "\" & Filename, ReadOnly:=True LastRow = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row With ThisWorkbook.ActiveSheet ActiveSheet.Range("A1:D" & LastRow).Copy .Cells(.Rows.Count, "A"). _ End(xlUp).Offset(1, 0) xlCopy = xlCopy + 1 Excel.Workbooks(Filename).Close End With End If Next If xlCopy > 0 Then MsgBox xlCopy & " Arquivos foram copiados do mês " & _ sMes, 64, " S u c e s s o " Erro: Excel.Application.ScreenUpdating = True End Sub -
Outro Copiar e Colar de Arquivos Diferentes
Basole respondeu ao tópico de viclizz em Programação - outros
Envie amostras de arquivos que quer importar os dados e o arquivo que receberá -
Visual Basic Microsoft Excel VBA 2019
Basole respondeu ao tópico de osvaldoborralho em Programação - outros
Nesta tela do editor do vbe do Excel, aperte as teclas ctrl+g na tela imediata: Digite debug.Print excel.Application.StartupPath e pressione ENTER. Deve aparecer um caminho de diretorio ,mais ou menos assim: C:\Users\User\AppData\Roaming\Microsoft\Excel\XLINÍCIO Cole este endereco no explorer e pressione ENTER. E delete os arquivos desta pasta que abrir. -
Visual Basic Tranformar multiplos arquivos CSV em um XLSX separado por abas
Basole respondeu ao tópico de Victor Marcel em Programação - outros
Abra o Excel em uma nova pasta de trabalho, crie um modulo e cole o codigo abaixo: Sub Teste() Dim myDir As String Dim fn As String Dim wb As Workbook Set wb = ActiveWorkbook With Application.FileDialog(msoFileDialogFolderPicker) If .Show Then myDir = .SelectedItems(1) & "\" End With If myDir = "" Then Exit Sub fn = VBA.Dir(myDir & "*.csv") Do While fn <> "" With Workbooks.Open(myDir & fn) .Sheets(1).Copy after:=wb.Sheets(wb.Sheets.Count) .Close False End With fn = Dir Loop End Sub O codigo importa todos os arquivos *.CSV selecionados, em abas diferentes, nomeando-as de acordo com o nome do arquvio. -
Excel Macro para mostrar planilha ocultas sem reexibir
Basole respondeu ao tópico de Paloma Brito em Microsoft Office e similares
Veja esta opcão, se lhe atende. Conforme imagem acima, veja como acessar os recursos 1- Click a direita da imagem, na Aba Prime Clean 2- A Esquerda da imagem, as opcões de navegacão (Selecionar uma aba [visível], Ordenar/ Classificar as abas, Selecionar uma aba oculta, Ocultar a aba ativa). DASHBOARD DE RECRUTAMENTO.zip -
Excel Copiar Range com Inputbox no Excel
Basole respondeu ao tópico de Etoruiz em Microsoft Office e similares
Tem sim. Segue o codigo completo, com as alteracoes solicitadas... Sub Duplicar_e_Renomear() Dim Rng As Range Dim newName As String Dim newSheet As Worksheet With ThisWorkbook Set newSheet = .Sheets.Add(After:= _ .Sheets(.Sheets.Count)) With .Sheets("Movimento do Dia") Set Rng = .Range(.Cells(1, 1), .Cells(28, 5)) Rng.Copy With newSheet.Range("A1") .PasteSpecial Paste:=xlPasteAll .PasteSpecial Paste:=xlPasteColumnWidths End With Set Rng = .Range(.Cells(1, 9), .Cells(2, 15)) Rng.Copy With newSheet.Range("I1") .PasteSpecial Paste:=xlPasteAll .PasteSpecial Paste:=xlPasteColumnWidths End With Excel.Application.CutCopyMode = False On Error GoTo Erro newName = InputBox("O nome do backup é:", "Renomeando...", newSheet.Name) newSheet.Name = newName End With End With MsgBox "Backup Realizado com Sucesso!!!", 64, Sucesso Exit Sub Erro: MsgBox Err.Description, 16 On Error GoTo 0 End Sub -
@Juliana.souza tem sim. Segue exemplo em anexo. Inserir_Imagem_ActiveX.zip
-
Excel Preencher um Formulario PDF com VBA
Basole respondeu ao tópico de R de Freitas em Microsoft Office e similares
@R de Freitas Como eu disse, nao tenho o Adobe pro, sendo assim nao posso testar e dar uma opiniao, pois podem ser varias coisas que estão interferindo no funcionamento do codigo de exemplo. De qualquer forma, veja se este outro exemplo lhe atende e ai adapta a sua planilha e seu formulário. Formulario_PDF.zip * Quem nao tem o adobe-pro e quiser testar pode imprimir os formularios gerados ou instalar uma impressora virtual, como por exemplo CutePDF Writer -
Excel Preencher um Formulario PDF com VBA
Basole respondeu ao tópico de R de Freitas em Microsoft Office e similares
Segue em anexo um exemplo de automatizacao * Nao testado, pois nao tenho o adobe-pro instalado Exemplo_PDF_Form.zip -
Excel Copiar Range com Inputbox no Excel
Basole respondeu ao tópico de Etoruiz em Microsoft Office e similares
Bom pelo que entendi voce quer criar uma nova aba e copiar os intervalos citados da aba "Movimento do Dia", criando um backup. Segue alteracao: Sub Duplicar_e_Renomear() Dim Rng As Range Dim newName As String Dim newSheet As Worksheet With ThisWorkbook Set newSheet = .Sheets.Add(After:= _ .Sheets(.Sheets.Count)) With .Sheets("Movimento do Dia") Set Rng = .Range(.Cells(1, 1), .Cells(28, 5)) Rng.Copy Destination:=newSheet.Range("A1") Set Rng = .Range(.Cells(1, 9), .Cells(2, 15)) Rng.Copy Destination:=newSheet.Range("I1") On Error GoTo Erro newName = InputBox("O nome do backup é:", "Renomeando...", newSheet.Name) newSheet.Name = newName End With End With MsgBox "Backup Realizado com Sucesso!!!", 64, Sucesso Exit Sub Erro: MsgBox Err.Description, 16 On Error GoTo 0 End Sub -
Excel Preencher um Formulario PDF com VBA
Basole respondeu ao tópico de R de Freitas em Microsoft Office e similares
É possivel através do Adobe Pro + VBA . Caso ao tenha o Adobe pro, outra opcao é o FoxitReader é um software gratuito, que você pode usar para importar ou exportar dados de um formulário PDF. -
Excel Copiar Range com Inputbox no Excel
Basole respondeu ao tópico de Etoruiz em Microsoft Office e similares
Fiz as alteracoes solicitadas. Veja se é isso: Sub Duplicar_e_Renomear() Dim Rng As Range Dim newSheet As Worksheet Set Rng = Sheets("Movimento do Dia").Range("A1:E28") Set newSheet = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) Rng.Copy Destination:=newSheet.Range("A1") newSheet.Name = InputBox("O nome do backup é:", "Renomeando...", newSheet.Name) MsgBox "Backup Realizado com Sucesso!!!" End Sub -
Visual Basic Exibir Intervalo do Excel em Form VB6
Basole respondeu ao tópico de Charley Rocha em Programação - outros
Uma opcao seria, inserir as textbox dinamicamente, criando a grid, de acordo com o intervalo (coluna X Linhas). Veja este exemplo: Dynamically Add Controls to a Form with Visual Basic 6.0 -
Excel Lista de planilhas - VBA
Basole respondeu ao tópico de Carolina Nemeth em Microsoft Office e similares
Segue com a alteração solicitada. Private Sub Worksheet_Activate() Dim ws As Worksheet, i As Integer Application.ScreenUpdating = False Sheets("ListaPlans").Range("A:B").ClearContents For Each ws In ThisWorkbook.Worksheets If ws.Name <> "ListaPlans" Then If ws.Visible = xlSheetVisible Then i = i + 1 With Sheets("ListaPlans") .Range("A" & i) = ws.Name .Hyperlinks.Add Anchor:=Range("A" & i), _ Address:="", SubAddress:="'" & ws.Name & _ "'!A1", TextToDisplay:=ws.Name .Range("B" & i) = "=" & ws.Name & "!F6" End With End If End If Next ws Application.ScreenUpdating = True End Sub -
Visual Basic VBA Com 'Range.Formula' para várias Celulas
Basole respondeu ao tópico de Pablo Terra em Programação - outros
Tente desta forma: Dim UltimaLinha As Long UltimaLinha = Range("H" & Rows.Count).End(xlUp).Row Range("H8:H" & UltimaLinha).Formula = "=NOW()-E8" -
Access Banco de Dados - Anexar Comentários do Excel
Basole respondeu ao tópico de zPenguin em Microsoft Office e similares
Sim eh possivel. Segue um exemplo. Ajuste no codigo no local indicado, de acordo com as caracteristicas dos seus arquivo excel e access. Sub EnviaComentariosExcelParaAccess() ' Ative as referências no editor do VB --> Ferramentas --> Referências --> Microsoft ActiveX Data Objects 6.1 Library ' Exporta dados dos comentarios da planilha ativa para uma tabela em um banco de dados do Access ' Este procedimento deve ser editado antes de usar Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long ' Conecta-se ao banco de dados do Access Set cn = New ADODB.Connection cn.Open "Provider=microsoft.ace.oledb.12.0; " & _ "Data Source=" & ThisWorkbook.Path & "\NOME_DA_SUA_TABELA_AQUI.accdb;" ' Abre um recordset Set rs = New ADODB.Recordset rs.Open "NOME_DA_SUA_TABELA_AQUI", cn, adOpenKeyset, adLockOptimistic, adCmdTable r = 1 'a linha inicial na planilha Do Until Range("A" & r).Comment Is Nothing ' Repete até a primeira célula vazia na coluna A With rs .AddNew 'criar um novo registro ' Adiciona comentarios a cada campo no registro On Error Resume Next .Fields("NOME_DO_CAMPO_1") = Range("A" & r).Comment.Text .Fields("NOME_DO_CAMPO_2") = Range("B" & r).Comment.Text .Fields("NOME_DO_CAMPO_3") = Range("C" & r).Comment.Text ' * Adicione mais campos, se necessário ... .Update ' armazena o novo registro End With r = r + 1 'proxima linha ... On Error GoTo 0 Loop rs.Close Set rs = Nothing cn.Close Set cn = Nothing End Sub -
Outro Organizar ou destacar linhas iguais em um texto
Basole respondeu ao tópico de kleberkbr em Programação - iniciantes
Use o excel -
Sim, fazer pesquisa com a inserção de mais de uma variável em toda a aba, já é algo mais simples: 1º Insira + um textbox para inserir os termos de pesquisa. 2º renomeei para txtPesquisa A macro vai entender que os espaços é o que separa, os termos que deverão ser pesquisados 3º substitua o código abaixo do botão pesquisar Private Sub btnPesquisar_Click() Dim r As Range Dim O_Q() As String Dim arrLB As Variant Dim i As Integer Dim ws1 As Worksheet O_Q() = VBA.Split(Me.txtPesquisa.Text) ReDim arrLB(0, 11) Set ws1 = Plan16 With Me.ListBox1 .ColumnCount = 11 .ColumnWidths = "30;40;50;40;80;50;70;70;70;70;70" .List = arrLB .Clear For i = LBound(O_Q) To UBound(O_Q) If VBA.IsDate(O_Q(i)) Then Set r = FindAll(VBA.CDate(O_Q(i))) Else Set r = FindAll(O_Q(i)) End If If Not r Is Nothing Then .AddItem .List(.ListCount - 1, 0) = ws1.Range("A" & r.Row).Value .List(.ListCount - 1, 1) = ws1.Range("B" & r.Row).Value .List(.ListCount - 1, 2) = ws1.Range("C" & r.Row).Value .List(.ListCount - 1, 3) = ws1.Range("D" & r.Row).Value .List(.ListCount - 1, 4) = ws1.Range("E" & r.Row).Value .List(.ListCount - 1, 5) = ws1.Range("F" & r.Row).Value .List(.ListCount - 1, 6) = ws1.Range("G" & r.Row).Value .List(.ListCount - 1, 7) = ws1.Range("H" & r.Row).Value .List(.ListCount - 1, 8) = ws1.Range("I" & r.Row).Value .List(.ListCount - 1, 9) = ws1.Range("J" & r.Row).Value .List(.ListCount - 1, 10) = ws1.Range("K" & r.Row).Value End If Next i End With Call HabilitaControles End Sub 4º E em um modulo, cole a função FindAll: (*esta função é que faz a pesquisa em toda as celulas na aba) Function FindAll(what, Optional SearchWhat As Variant, _ Optional LookIn, _ Optional LookAt, _ Optional SearchOrder, _ Optional SearchDirection As XlSearchDirection = xlNext, _ Optional MatchCase As Boolean = False, _ Optional MatchByte, _ Optional SearchFormat) As Range Dim aRng As Range If IsMissing(SearchWhat) Then On Error Resume Next Set aRng = ActiveSheet.UsedRange On Error GoTo 0 ElseIf TypeOf SearchWhat Is Range Then If SearchWhat.Cells.Count = 1 Then Set aRng = SearchWhat.Parent.UsedRange Else Set aRng = SearchWhat End If ElseIf TypeOf SearchWhat Is Worksheet Then Set aRng = SearchWhat.UsedRange Else Exit Function '***** End If If aRng Is Nothing Then Exit Function '***** Dim FirstCell As Range, CurrCell As Range With aRng.Areas(aRng.Areas.Count) Set FirstCell = .Cells(.Cells.Count) End With Set FirstCell = aRng.Find(what:=what, After:=FirstCell, _ LookIn:=LookIn, LookAt:=LookAt, _ SearchDirection:=SearchDirection, MatchCase:=MatchCase, _ MatchByte:=MatchByte, SearchFormat:=SearchFormat) If FirstCell Is Nothing Then Exit Function '***** Set CurrCell = FirstCell Set FindAll = CurrCell Do Set FindAll = Application.Union(FindAll, CurrCell) Set CurrCell = aRng.Find(what:=what, After:=CurrCell, _ LookIn:=LookIn, LookAt:=LookAt, _ SearchDirection:=SearchDirection, MatchCase:=MatchCase, _ MatchByte:=MatchByte, SearchFormat:=SearchFormat) Loop Until CurrCell.Address = FirstCell.Address End Function Até é possível, mas já é mais complicado para atender esta demanda, pois tem que criar muitas condições e fazer tipo uma pesquisa em um banco de palavras para comparar o que foi digitado e fazer a correção.
-
Word Preenchimento condicional de formulários
Basole respondeu ao tópico de Rafael Damian em Microsoft Office e similares
@Rafael Damian para que possam entender melhor o que você precisa e analisar o formato do seu Documento, poste seu arquivo ou um modelo bem próximo. -
Excel VBA Destacar linha e coluna selecionada sem alterar cores
Basole respondeu ao tópico de Tiago Dalbosco Da Silva em Microsoft Office e similares
Não sei se entendi bem o que precisa, de qualquer forma veja se é isso: Private Sub Worksheet_SelectionChange(ByVal Target As Range) ' Clear the color of all the cells Cells.Interior.ColorIndex = 0 If IsEmpty(Target) Or Target.Cells.Count > 1 Then Exit Sub Application.ScreenUpdating = False With ActiveCell ' Highlight the row and column that contain the active cell, within the current region Range(Cells(.Row, .CurrentRegion.Column), Cells(.Row, .CurrentRegion.Columns.Count + _ .CurrentRegion.Column - 1)).Interior.ColorIndex = ActiveSheet.Tab.ColorIndex End With Application.ScreenUpdating = True End Sub -
Neste modelo você pode pesquisar em qualquer campo, mas tem que digitar o termo no campo correto e com essas alterações abaixo no botão de pesquisa: Substitua o código do botão "Pesquisar Registro" por este: Private Sub btnPesquisar_Click() Dim lngRow As Long Dim X As Long, y As Long: y = 0 Dim o que As String If Me.txtID.Text <> "" Then X = 1: o que = Me.txtID.Text: GoTo Px If Me.txtSolicitante.Text <> "" Then X = 3: o que = Me.txtSolicitante.Text: GoTo Px If Me.txtREQ.Text <> "" Then X = 4: o que = Me.txtREQ.Text: GoTo Px If Me.cboComplexidade.Text <> "" Then X = 5: o que = Me.cboComplexidade.Text: GoTo Px If Me.cboTI.Text <> "" Then X = 7: o que = Me.cboTI.Text: GoTo Px If Me.txtResponsavel.Text <> "" Then X = 9: o que = Me.txtResponsavel.Text: GoTo Px If Me.cboStatus.Text <> "" Then X = 10: o que = Me.cboStatus.Text: GoTo Px Px: With ThisWorkbook.Worksheets("Demandas Internas") lngRow = fMatch(o que, .Columns(X)) If lngRow = 0 Then MsgBox "Dados não encontrados!", vbCritical Else Call Multipla_Pesquisa Call HabilitaControles End If End With End Sub * Substitua no codigo o que for "o que" pela letra O + a letra q pois o corretor alterou tudo Conforme a imagem: No botão "Cancelar", pra mim aqui está ok. Já o "fechar" mantenha somente o unload me , pois não existe neste modelo o userform frmMenu, por isso o erro. Private Sub cmdFechar_Click() Unload Me 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