-
Posts
239 -
Cadastrado em
-
Última visita
Tópicos solucionados
-
O post de Muca Costa em Enviar e-mail através de Macro com arquivo em PDF em anexo foi marcado como solução
Veja se o anexo ajuda.
E-mail.rar
-
O post de Muca Costa em Macro Validação de Dados e Copia de Linhas com Colunas Específicas foi marcado como solução
Sub Teste() Dim P As String, UltimaLinha As String, Lin As String, i As Integer P = Planilha1.Cells(Rows.Count, "A").End(xlUp).Row Planilha1.Range("A2:R" & P) = "" UltimaLinha = Planilha2.Cells(Rows.Count, "A").End(xlUp).Row Lin = 2 For i = 3 To UltimaLinha Planilha1.Cells(Lin, 1) = Planilha2.Cells(i, 2) Planilha1.Cells(Lin, 3) = Planilha2.Cells(i, 14) Planilha1.Cells(Lin, 4) = Planilha2.Cells(i, 22) Planilha1.Cells(Lin, 6) = Planilha2.Cells(i, 14) Planilha1.Cells(Lin, 7) = Planilha2.Cells(i, 21) Planilha1.Cells(Lin, 8) = Planilha2.Cells(i, 14) Planilha1.Cells(Lin, 9) = Planilha2.Cells(i, 108) Planilha1.Cells(Lin, 12) = Planilha2.Cells(i, 19) Planilha1.Cells(Lin, 17) = Planilha2.Cells(i, 23) Planilha1.Cells(Lin, 24) = Planilha2.Cells(i, 17) Planilha1.Cells(Lin, 25) = Planilha2.Cells(i, 18) Planilha1.Cells(Lin, 18) = Planilha2.Cells(i, 106) Lin = Lin + 1 Next MsgBox "Filtro finalizado" End Sub
-
O post de Muca Costa em VBA - Rodar rotina quando alterar células com fórmulas foi marcado como solução
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...
-
O post de Muca Costa em VBA - Encontrar última célula preenchida e duplicar linha foi marcado como solução
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
-
O post de Muca Costa em Macro que abre arquivo em PDF foi marcado como solução
2º - Exemplo: Se o caminho for informado em B2, mude, na macro, para:
stAppName = "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe " & Range("B2") & "\" & Arq
1º - Essa eu fico devendo...
-
O post de Muca Costa em macro para copiar e localizar dados no excel foi marcado como solução
Tente assim:
Sub FiltroCodigo()
Dim P As String, Lin As String, i As Integer
Range("A3").Select
Selection.Copy
Sheets("TCPO").Select
With ActiveSheet
P = Planilha1.Cells(.Rows.Count, "A").End(xlUp).Row
End With
Range("F1").Select
ActiveSheet.Paste
Lin = 5
For i = 5 To P
If Planilha1.Cells(i, 1) = Range("F1") Then
Range("A" & i).Select
End If
Lin = Lin + 1
Next
MsgBox Range("F1") & " Selecionado"
Range("F1") = ""
End Sub
-
O post de Muca Costa em Criar consulta em que busque as 3 maiores datas foi marcado como solução
Veja o anexo. Click no botão Top 3 para atualizar a tabela tblTopVendas...
Top.rar
-
O post de Muca Costa em Sintaxe para indicar variável foi marcado como solução
Veja o anexo, click no botão para acrescentar...
PreenchimentoAutomático-002.rar
-
O post de Muca Costa em Acrescentar dias entre duas datas foi marcado como solução
Resolvi com base no procedimento do Basole. Ficou assim:
Dim dtIni As Date, dtFin As Date, j As Long, N As String, De As String
dtIni = VBA.Format(Me.dtIni, "Short Date")
dtFin = VBA.Format(Me.dtFin, "Short Date")
N = Me.nDias
De = Me.Descricao
DoCmd.SetWarnings False
For j = 1 To N
CurrentDb.Execute "INSERT INTO tblAusencias(DataFeriado, Semana, Descrição)" _
& " Values(""" & Format(dtIni, "dd/mm/yyyy") & """,""" & WeekdayName(Weekday(dtIni)) & """," _
& """" & De & """);"
dtIni = dtIni + 1
Next j
DoCmd.SetWarnings True
MsgBox j + 1 & " resgistros Salvos", 64, "Sucesso"
-
O post de Muca Costa em VBA localiza a aba e seleciona foi marcado como solução
Tente isso:
Sub AbreAba()
Dim nome As String
nome = InputBox("Insira o nome da Aba", "Abre Aba")
Sheets(nome).Select
End Sub
-
O post de Muca Costa em Complementar código VBA para automatização e melhoria de faturamento. foi marcado como solução
Veja se lhe atende. Click no botão "Atualizar Abas" ...
Planilha em anexo.
GERAL.rar
-
O post de Muca Costa em Dias úteis sem relação de feriados foi marcado como solução
Veja a solução aqui: https://ask.libreoffice.org/pt-br/question/82632/dias-uteis-sem-relação-de-feriados/
-
O post de Muca Costa em CONSOLIDAR PLANILHAS foi marcado como solução
Resolvido: Sub Consolidar e Sub Limpar, oriundas do Excel; Sub formatar do Calc
REM ***** BASIC *****
Option VBASupport 1
Sub Consolidar()
Sheets(1).Range("A2:L5001").ClearContents
plans = Sheets.Count
linha = 2
For n = 2 To plans
lin = 2
Do Until Sheets(n).Cells(lin, 1) = ""
Sheets(1).Cells(linha, 1) = Sheets(n).Cells(lin, 1)
Sheets(1).Cells(linha, 2) = Sheets(n).Cells(lin, 2)
Sheets(1).Cells(linha, 3) = Sheets(n).Cells(lin, 3)
Sheets(1).Cells(linha, 4) = Sheets(n).Cells(lin, 4)
Sheets(1).Cells(linha, 5) = Sheets(n).Cells(lin, 5)
Sheets(1).Cells(linha, 6) = Sheets(n).Cells(lin, 6)
Sheets(1).Cells(linha, 7) = Sheets(n).Cells(lin, 7)
Sheets(1).Cells(linha, 8) = Sheets(n).Cells(lin, 8)
Sheets(1).Cells(linha, 9) = Sheets(n).Cells(lin, 9)
Sheets(1).Cells(linha, 10) = Sheets(n).Cells(lin, 10)
Sheets(1).Cells(linha, 11) = Sheets(n).Cells(lin, 11)
Sheets(1).Cells(linha, 12) = Sheets(n).Cells(lin, 12)
'Sheets(1).Cells(linha, 13).Font.ColorIndex = n + 1
'Sheets(1).Cells(linha, 13) = Sheets(n).Name
lin = lin + 1
linha = linha + 1
Loop
Next
Formatar
msgbox "Consolidado!"
End Sub
Sub Limpar()
Sheets(1).Range("A2:L5001").ClearContents
End Sub
sub Formatar
rem ----------------------------------------------------------------------
rem define variables
dim document as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "$B$2:$B$5001"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
rem ----------------------------------------------------------------------
dim args2(0) as new com.sun.star.beans.PropertyValue
args2(0).Name = "NumberFormatValue"
args2(0).Value = 36
dispatcher.executeDispatch(document, ".uno:NumberFormatValue", "", 0, args2())
rem ----------------------------------------------------------------------
args1(0).Name = "ToPoint"
args1(0).Value = "$D$2:$D$5001"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
rem ----------------------------------------------------------------------
args2(0).Name = "NumberFormatValue"
args2(0).Value = 40
dispatcher.executeDispatch(document, ".uno:NumberFormatValue", "", 0, args2())
rem ----------------------------------------------------------------------
args1(0).Name = "ToPoint"
args1(0).Value = "$I$2:$I$5001"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
rem ----------------------------------------------------------------------
args2(0).Name = "NumberFormatValue"
args2(0).Value = 36
dispatcher.executeDispatch(document, ".uno:NumberFormatValue", "", 0, args2())
rem ----------------------------------------------------------------------
args1(0).Name = "ToPoint"
args1(0).Value = "$J$2:$J$5001"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
rem ----------------------------------------------------------------------
args2(0).Name = "NumberFormatValue"
args2(0).Value = 36
dispatcher.executeDispatch(document, ".uno:NumberFormatValue", "", 0, args2())
rem ----------------------------------------------------------------------
args1(0).Name = "ToPoint"
args1(0).Value = "$K$2:$K$5001"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
rem ----------------------------------------------------------------------
args2(0).Name = "NumberFormatValue"
args2(0).Value = 36
dispatcher.executeDispatch(document, ".uno:NumberFormatValue", "", 0, args2())
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