Basole

Alterei para converter a celula apenas se o resultado for Hoje() Ou seja se o resultado da formula for Hoje() entao substituirá por 25/03/2020 Caso contrario continuaá a formula com o resultado Ok Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Not Intersect(Target, Range("A2:A100")) Is Nothing Then With Target If Target.Value = VBA.Date Then .Value = .Value End If End With End If On Error GoTo 0 End Sub

@David Guilherme Perandré para os dados da celula com a formula Hoje não se alterarem voce precisa converte-los em valores Segue exemplo: Cole o codigo abaixo no modulo vbe da sua planilha (aba) . E altere no codigo o intervalo das celulas que deseja inserir a formula Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Not Intersect(Target, Range("A2:A100")) Is Nothing Then With Target .Value = .Value End With End If On Error GoTo 0 End Sub

Desculpe mas nao entendi sua demanda

Segue opcão de criar a lista em um arquivo do Excel através de um script vbs Abra o Bloco de notas e coloque o seguinte código vbscript Dim objFSO Dim objFolder Dim objFile Dim i Dim xls Dim Wb Set xls = CreateObject("Excel.Application") xls.Visible = True Set Wb = xls.Workbooks.Add() Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder("C:\Temp") '*** ALTERE O CAMINHO DA SUA PASTA ***** i = 1 With Wb.Sheets(1) .Cells(i, 1) = "Name" .Cells(i, 2) = "Extension" .Cells(i, 1).Font.Bold = True .Cells(i, 2).Font.Bold = True For Each objFile In objFolder.Files .Cells(i + 1, 1) = Left(objFile.Name, InStr(objFile.Name, ".") - 1) .Cells(i + 1, 2) = "." & objFSO.getextensionname(objFile.Path) i = i + 1 Next .range("A:A").Columns.AutoFit .range("B:B").Columns.AutoFit End With Wb.SaveAs (objFolder & "\Lista_de_Musica.xlsx") '*** ALTERE O CAMINHO DA SUA PASTA E NOME DO ARQUVO C/ EXTENSAO***** 'wb.Close 'Fecha o excel Após alterar o caminho correto dos arquivos de nusica e do arquivo excel 9que sera gerado), no script acima, salve o vbscript com a extensão .vbs Opcional: Crie um atalho para o arquivo vbs e coloque-o na área de trabalho do usuário (você pode alterar o ícone do atalho para mostrar o ícone do excel clicando com o botão direito do mouse e escolhendo Propriedades / guia Atalho / botão Alterar ícone) :

Tente formatar o textbox com o dia e mes invertidos Planilha13.Range("J3") = VBA.Format(Recebimento, "mm/dd/yyyy")

@Adriana Cabral Experimente a formula abaixo para retornar a linha do numero de telefone com a data mais recente =PROC(2;1/($C$2:$C$3312=C2);LIN($B$2:$B$3312))

@João Gabriel Lira consegui baixar o arquivo Base - 20.03.2017.zip sem problemas. Esta disponível para downloads

Segue o codigo atualizado Sub SeuBotao() With ActiveSheet With .PageSetup .PrintArea = Selection.Address .Zoom = False .FitToPagesWide = 1 .FitToPagesTall = 1 End With .PrintPreview .PrintOut copies:=1 End With End Sub

@Gonzallez siga o passo-a-passo: Inserir código VBA na pasta de trabalho do Excel Abra sua pasta de trabalho no Excel. Pressione Alt + F11 para abrir o Visual Basic Editor (VBE). Clique com o botão direito do mouse no nome da pasta de trabalho no painel "Project-VBAProject" (no canto superior esquerdo da janela do editor) e selecione Inserir -> Módulo no menu de contexto. Copie o código do VBA (Que inseri no meu poste anterior.) e cole-o no painel direito do editor do VBA (janela "Módulo1"). Salve sua pasta de trabalho. Feche a janela e Aperte as teclas ALT+F8 e clique em executar

Segue exemplo basico: Sub SeuBotao() With ActiveSheet.PageSetup .PrintArea = Selection.Address .Zoom = False .FitToPagesWide = 1 .FitToPagesTall = 1 End With ActiveSheet.PrintOut copies:=1 End Sub

@Gonzallez Atualizei a macro de acordo com sua solicitacao * 1- Cria uma nova pasta para armazenar as imagens que serao "baixadas", chamada FOTOS (caso nao exista), localizada na mesma pasta da planilha. 2 - Renomea a imagem de acordo com a coluna B 3 - Insere um hyperlink na coluna N armazenando o endereco (caminho), de cada imagem "baixada". Sub DownloadImagensRenameTitle() Dim sURI As Range Dim Lr! Lr = Range("N" & Rows.Count).End(xlUp).Row Set oXMLHTTP = VBA.CreateObject("MSXML2.XMLHTTP.6.0") Set oBinaryStream = VBA.CreateObject("ADODB.Stream") adTypeBinary = 1 oBinaryStream.Type = adTypeBinary FolderName = ThisWorkbook.Path & "\FOTOS" If VBA.Len(VBA.Dir(FolderName, VBA.vbDirectory)) = 0 Then VBA.MkDir FolderName 'cria NOVA pasta, caso nao exista End If For i = 2 To Lr sPath = FolderName & "\" & Range("B" & i).Value2 & ".jpg" Set sURI = Range("N" & i) On Error GoTo HTTPError oXMLHTTP.Open "GET", sURI.Value2, False oXMLHTTP.Send aBytes = oXMLHTTP.responsebody On Error GoTo 0 oBinaryStream.Open oBinaryStream.Write aBytes adSaveCreateOverWrite = 2 oBinaryStream.SaveToFile sPath, adSaveCreateOverWrite oBinaryStream.Close ActiveSheet.Hyperlinks.Add Anchor:=sURI, _ Address:=FolderName & "\" & Range("B" & i).Value2 & ".jpg", _ SubAddress:="", _ ScreenTip:=Range("B" & i).Value2, _ TextToDisplay:=Range("B" & i).Value2 NextRow: Next Exit Sub HTTPError: Resume NextRow End Sub Veja se e isso!

Segue exemplo, a macro insere o hyperlink na celula a lado da celula selecionada. Sub SEU_BOTAO() With Application.FileDialog(msoFileDialogFilePicker) .Title = "Selecione um Arquivo Pdf" .AllowMultiSelect = False .Filters.Clear .Filters.Add "Pdf Files", "*.pdf; *.pdf; *.pdf; *.pdf", 1 .Show On Error GoTo ex fullpath = .SelectedItems.Item(1) End With If VBA.InStr(fullpath, ".pdf") = 0 Then ex: Exit Sub End If Set objFSO = CreateObject("Scripting.FileSystemObject") ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell.Offset(, 1), _ Address:=fullpath, TextToDisplay:=objFSO.Getfile(fullpath).Name, ScreenTip:=objFSO.Getfile(fullpath).Name End Sub

Veja se e isso que deseja A macro substitui a url por hyperlink com o titulo do respectivo livro, mantendo o endereco da imagem. Tabela_de_Produtos.xls

Substitua as linhas abaixo no seu código. Cells(ActiveCell.Row, 1) = VBA.Format(Mid(Conteudodalinha, 1, 10), "mm/dd/yyyy") 'Preenche a linha na col 1 Cells(ActiveCell.Row, 7) = VBA.Format(Mid(Conteudodalinha, 52, 10), "mm/dd/yyyy") 'Preenche a linha na col 7

Veja se e isso que deseja!!! cadastros_1.zip

Segue sugestao em vbs Cole o codigo abaixo no bloco de notas e salve com as extensao *.vbs Set fso = CreateObject("Scripting.FileSystemObject") 'ALTERE O CAMINHO E NOME ARQUIVO TXT QUE CONTEM OS DADOS DOS ARQUIVOS SERAO IMPRESSOS Set file = fso.OpenTextFile("c:\Temp\Teste.txt", 1) Do Until file.AtEndOfStream Line = file.Readline If fso.FileExists(Line) Then CreateObject("Shell.Application").Namespace(0).ParseName(Line).InvokeVerb ("Print") End If Loop

Segue exemplo de código vba de acordo com as imagens * Cole o c[odigo abaixo, no modulo da Plan1 Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Range Dim Lr As Long If Target.Address = "$C$4" Then Set r = Range(Cells(Target.Row, 3), Cells(Target.Row, 5)) With Worksheets("Plan2") Lr = .Cells(.Rows.CountLarge, 1).End(xlUp).Offset(1).Row .Cells(Lr, 4) = VBA.Date .Cells(Lr, 5) = VBA.Time With .Cells(Lr, 1) _ .Resize(r.Rows.CountLarge, r.Columns.CountLarge) .Value = r.Value2 End With End With End If End Sub

Segue exemplo de código vba de acordo com as imagens * Cole o c[odigo abaixo, no modulo da Plan1 Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Range Dim Lr As Long If Target.Address = "$C$4" Then Set r = Range(Cells(Target.Row, 3), Cells(Target.Row, 5)) With Worksheets("Plan2") Lr = .Cells(.Rows.CountLarge, 1).End(xlUp).Offset(1).Row .Cells(Lr, 4) = VBA.Date .Cells(Lr, 5) = VBA.Time With .Cells(Lr, 1) _ .Resize(r.Rows.CountLarge, r.Columns.CountLarge) .Value = r.Value2 End With End With End If End Sub

@GuilhermeST nao sei se ja o fez, mas é necessário atribuir ao botao a macro. * Clique com botao direito sobre o botao, e aparera as opções. Segue uma outra opcao caso o exemplo anterior nao funcione para o seu cenario * Foi testado com o Adobe Acrobat Reader Sub Exemplo() ActiveWorkbook.FollowHyperlink "C:\USers\user\Documents\SEU_ARQUIVO_PDF.pdf" With Application .Wait (VBA.Now() + VBA.TimeValue("00:00:05")) 'aguarda 5 segundos .SendKeys ("^p"), True 'Print crt+p .Wait (VBA.Now() + VBA.TimeValue("00:00:03")) 'aguarda 3 segundos .SendKeys ("~"), True ' Enter .Wait (VBA.Now() + VBA.TimeValue("00:00:08")) 'aguarda 8 segundos .SendKeys ("^q"), True 'Fecha o pdf End With End Sub *Altere o caminho e nome do arquivo pdf que deseja imprimir

Aqui pra funciona perfeitmente. @GuilhermeST mostre o código de erro, de repente podemos ajudar a investigar o problema. Aprimorei o codigo para o usuario selecionar o arquivo pdf Sub SeuBotao() Dim sPathPdf As String With Application.FileDialog(msoFileDialogFilePicker) .AllowMultiSelect = False .Filters.Add "PDF Files", "*.pdf; *.pdf, 1" .Show sPathPdf = .SelectedItems.Item(1) End With If VBA.InStr(sPathPdf, ".pdf") = 0 Then Exit Sub Else VBA.CreateObject("Shell.Application").Namespace(0).ParseName(sPathPdf).InvokeVerb ("Print") End If End Sub

@GuilhermeST pela imagem nao da pra ver, mas verifique se inseriu corretamente o caminho do arquivo, nome e a extensao "pdf"sem as aspas.

Segue exemplo generico.... *Altere o caminho e nome do arquivo pdf que deseja imprimir Sub SeuBotao() Dim sPathPdf As String: sPathPdf = "c:\Users\user\Documents\SEU_ARQUIVO_PDF.pdf" VBA.CreateObject("Shell.Application").Namespace(0).ParseName(sPathPdf).InvokeVerb ("Print") end sub

@DaviCN a questao do filtro por dias,apenas uma coluna para todos os dias ficaria mais funcional. Quanto a questao da exclusao das dos itens nao entendi exatamente o que precisa. SISTEMA IDEO.zip

@Tarciso_jr nao sei se ja resolveu, mas segue uma sugestão. Re-ajeitei os dados para ficar como lay-out de folha de dados eu utilizei algumas colunas auxiliares para nao estender a formula. Escopo Serviços com detalhamento_1.xlsx