Basole

Veja este exemplo: Dim LR As Long Dim LC As Long With ActiveSheet On Error Resume Next If .AutoFilterMode Then .ShowAllData End If On Error GoTo 0 LR = .Cells(.Rows.Count, 1).End(xlUp).Row LC = .Cells(1, .Columns.Count).End(xlToLeft).Column .Range(.Cells(1, 1), .Cells(LR, LC)).AutoFilter Field:=1, Criteria1:=RGB(255, _ 255, 204), Operator:=xlFilterCellColor ActiveWindow.SmallScroll Down:=-12 .Range("A2").Select .Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.EntireRow.Delete LR = .Cells(.Rows.Count, 1).End(xlUp).Row .Range(.Cells(1, 1), .Cells(LR, LC)).AutoFilter Field:=1 On Error Resume Next If .AutoFilterMode Then .ShowAllData End If On Error GoTo 0 End With

Desculpe, mas acho que não entendeu. Tem que substituir toda a linha: Set aCell = .Columns(X).Find(What:=o que, _ LookIn:=xlValues, LookAt:=xlPart, _ SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) Por Esta: Set aCell = .Columns(X).Find(What:=o que, _ LookIn:=xlValues, LookAt:=xlPart) E tambem o corretor ortográfico aqui do forum, ele altera algumas coisa do código, que postamos aqui Por exemplo:o que o correto é a letra O junto com a letra q. Não dá em pra por junto as letras, que ele altera, após salvar o post

Desculpe @kika.gunesim desconsidere minhas mensagens anteriores .... Eu fiz um teste aqui no Mac e rodou, o unico problema que apresentou ate agora foi no comando de pesquisa. Mas até ja resolvi agora. *O motivo das minhas afirmacoes anterirores, é que teve um outro caso que tive que criar um novo Userform, pois o Mac naó deixava nem abrir no vbe. O erro que apresentou aqui pra mim foi na pesquisa. No Sub Multipla_Pesquisa Altere a linha Set aCell = .Columns(X).Find(oq_ Lookin:= .... por esta: Set aCell = .Columns(X).Find(o que, _ Lookin:=xlvalues, LookAt:=xlPart) Set aCell = .Columns(X).Find(o que, _ Lookin:=xlvalues, LookAt:=xlPart) adicionado 20 minutos depois Insira um novo Módulo, e neste modulo coloque a macro para abrir o Form. Sub Abrir_Form() frmDemandasInternas.Show End Sub Click com o botão direito do mouse sobre o botão e selecione Atribuir Macro, e selecione: Abrir_Form

Sim poderá aproveitar o codigo, talvez tenha alguma diferenças que envolve os codigos de cores do MAC, mas pode ser substituidos. Seria bom se pudesse abrir este formulario no Win, para 'pegar' as informações dos nomes dos controles para depois voce ter esses dados quando for criar no Mac. Não entendi que botão é esse.

Sinto em dizer isso, mas o Formulário (userform), criado no Excel Win, não roda no Excel Mac. Então terá que criar um novo Formulário com todos os controles, textbox, label, botões e etc e para aproveitar o mesmo código, terá que renomear os controles de acordo com o que está no formulário Excel/Win, assim não precisará fazer alterações no codigo.

Creio que o que postei atende essa dificuldade. Sem um modelo ou exemplo, fica difícil querer te ajudar.

@kika.gunesim há diferenças sim, entre o ambiente Win e Mac. Qual a versão do office Mac, que você esta utilizando?

Experimente isso: Sub Remove_celulas_EmBranco() With Range("A3:A100") ' Altere seu intervalo .Value = .Value .SpecialCells(xlCellTypeBlanks).Cells.Delete End With End Sub

@Julianapctt já alterei a macro. "O ministério da saúde adverte, use a mesclagem de células, com moderação". A macro segue a ordem que aparece no visual. No caso do exemplo abaixo Set, Jan, Out, Nov Despesas VBA.xls

@Flávia de Oliveira Batista veja agora, com as alterações a variável Resultados só carrega dados distintos obtidos na pesquisa Private Sub ProcuraPersonalizada(ByVal Pesquisa As String) Dim Busca As Range Dim Primeiro As String Dim Resultados, ABA As String Dim bNaoExist As Boolean Dim dic As Object ABA = ComboBox1.Text Set dic = CreateObject("Scripting.Dictionary") 'Executa a busca With Worksheets(ABA).Range("A:G") Set Busca = .Find(What:=Pesquisa, AFTER:=Range("A1"), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _ SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) 'Caso tenha encontrado alguma ocorrência... If Not Busca Is Nothing Then Primeiro = Busca.Address 'Neste loop, pesquisa todas as próximas ocorrências para o termo pesquisado Do 'Condicional para não listar o primeiro resultado pois já foi listado acima If Not Busca.Address Like Primeira_Ocorrencia Then ' Verifica se já existe na coleção essa ocorncia^: If Not dic.Exists(Busca.Row) Then ' .. e se não existir adiciona: dic.Add Busca.Row, Value bNaoExist = True End If If bNaoExist Then If Resultados = "" Then Resultados = Busca.Row Else Resultados = Resultados & ";" & Busca.Row End If bNaoExist = False End If End If Set Busca = Cells.FindNext(AFTER:=Busca) Loop Until Busca.Address Like Primeiro MatrizResultados = Split(Resultados, ";") Set dic = Nothing Resultados = "" 'Atualiza dados iniciais no formulário SpinButton1.Max = UBound(MatrizResultados) 'Valor maximo do seletor de registros 'habilita o seletor de registro SpinButton1.Enabled = True 'indicador do seletor de registros Label_Registros_Contador.Caption = "1 de " & UBound(MatrizResultados) + 1 'Resultados encontrados NOME = Cells(MatrizResultados(0), 4).Value strFile = Right(NOME, Len(NOME) - InStrRev(NOME, "\")) TextBox1.Text = strFile 'nome TextBox3.Text = Cells(MatrizResultados(0), 2).Value 'autor TextBox4.Text = Cells(MatrizResultados(0), 3).Value 'data TextBox5.Text = Cells(MatrizResultados(0), 4).Value 'endereço TextBox6.Text = Cells(MatrizResultados(0), 1).Value 'extensão Else 'Caso nada tenha sido encontrado, exibe mensagem informativa SpinButton1.Enabled = False 'desabilita o seletor de registros Label_Registros_Contador.Caption = "" 'zera os resultados encontrados 'limpa os campos do formulário TextBox1.Text = "" TextBox5.Text = "" TextBox3.Text = "" TextBox4.Text = "" MsgBox "Nenhum resultado para '" & Pesquisa & "' foi encontrado." End If End With End Sub

@Flávia de Oliveira Batista da forma que estava, ajustava somente a 1ª pagina, por isso que não estava funcionando para todas as paginas do pdf. Com as alterações que fiz todas Planilhas (Abas), são ajustadas para uma pagina. *Mas quando se tem muitas colunas o Excel automaticamente diminui o zoom, e com isso diminuindo todo o conteúdo, principalmente a fonte. Sendo assim eu alterei a folha para orientação paisagem para melhorar a visualização, para esses casos. Altere somente este trecho: For i = 1 To apXLS.Worksheets.Count apXLS.Worksheets(i).Visible = xlSheetVisible apXLS.Worksheets(i).Select Replace:=False With apXLS.Worksheets(i).PageSetup .Zoom = False .FitToPagesWide = 1 .FitToPagesTall = False .Orientation = xlLandscape ' Modo Paissagem End With Next i E desconsidere este trecho abaixo, do código anterior, que já foi incorporado acima: With apXLS.ActiveSheet.PageSetup .FitToPagesWide = 1 .FitToPagesTall = False End With

Para salvar todas as abas em um único arquivo Pdf, eu fiz as alterações necessárias, abaixo: * Mas lembre-se que dependendo as distribuições dos dados em colunas afastadas, quando salvar em pdf, o que ultrapassar no limite da largura das paginas, serão impressas nas linhas abaixo deixando a formatação desconfigurado. Dim oXLS As Object Dim apXLS As Object Dim PastaDest As String Dim NomeArq As String dim i as integer Set oXLS = CreateObject("Excel.Application") Set apXLS = oXLS.Workbooks.Open("C:\users\USUARIO\Documents\NOME_DO_ARQUIVO_XLS.xlsx") ' Seleciona todas as abas: For i = 1 To apXLS.Worksheets.Count apXLS.Worksheets(i).Select Replace:=False Next i PastaDestino = "C:\temp\" NomeArq = "Teste_Salvar_XLS_p_PDF" ' Ajusta para uma pagina With apXLS.ActiveSheet.PageSetup .FitToPagesWide = 1 .FitToPagesTall = False End With apXLS.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PastaDestino & NomeArq & ".pdf", Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False apXLS.Close SaveChanges:=False Set oXLS = Nothing Set apXLS = Nothing

Não. no exemplo eu defini para 1ª aba => Set shXLS = apXLS.Worksheets(1) Mas voce pode ajustar para as outas abas 2, 3 , 4, ...etc Set shXLS = apXLS.Worksheets(2) ou 3, ou 4, etc

@Flávia de Oliveira Batista eu editei o meu ultimo post e acrescentei para o formato Excel

@Flávia de Oliveira Batista alem dessas alterações que citou, tem mais algumas diferenças que devem ser ajustadas, para cada aplicativo: Exemplo do PowerPoint: Dim oPPT As Object Dim apPPT As Object Dim PastaDest As String Dim NomeArq As String Set oPPT = CreateObject("PowerPoint.Application") Set apPPT = oPPT.Presentations.Open("C:\users\USUARIO\Documents\NOME_DO_ARQUIVO_POWERPOINT.pptx") PastaDestino = "C:\temp\Pasta_PDF" NomeArq = "Teste_Salvar_PPT_p_PDF" apPPT.SaveAs Filename:=PastaDestino & NomeArq & ".pdf", FileFormat:=32 apPPT.Close oPPT.Quit Set oPPT = Nothing Set apPPT = Nothing E agora, o mesmo exemplo adaptado para o Excel: Dim oXLS As Object Dim apXLS As Object Dim shXLS As Worksheet Dim PastaDest As String Dim NomeArq As String Set oXLS = CreateObject("Excel.Application") Set apXLS = oXLS.Workbooks.Open("C:\users\USUARIO\Documents\NOME_DO_ARQUIVO_XLS.xlsx") Set shXLS = apXLS.Worksheets(1) 'Define a 1ª aba PastaDestino = "C:\temp\Pasta_PDF" NomeArq = "Teste_Salvar_XLS_p_PDF" shXLS.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PastaDestino & NomeArq & ".pdf", Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False apXLS.Close SaveChanges:=False Set oXLS = Nothing Set apXLS = Nothing

Sim, é possível. Veja este exemplo com um arquivo do word. Dim oDoc As Object Dim apDoc As Object Dim PastaDest As String Dim NomeArq As String Set oDoc = CreateObject("Word.Application") Set apDoc = oDoc.Documents.Open("C:\users\USUARIO\Documents\NOME_DO_ARQUIVO_WORD.docx") PastaDestino = "C:\temp\Pasta_PDF\" NomeArq = "Teste_Salvar_Doc_p_PDF" oDoc.ActiveDocument.ExportAsFixedFormat _ OutputFileName:=PastaDestino & NomeArq & ".pdf", _ ExportFormat:=17 apDoc.Close SaveChanges:=False oDoc.Quit Set oDoc = Nothing Set apDoc = Nothing

Em uma rede todo computador tem o seu endereço. Assim como uma pagina da web http://www.google.com.br Na rede: Pelo nome \\PC\Users\USUARIO\Desktop.... Ou Pelo IP \\192.168.0.123\Users\USUARIO\Desktop.... Ou tambem voce pode mapear a rede, referenciando o diretório do seu banco, com um comando, quando abrir seu arquivo Exemplo: Net Use X: \\192.168.1.123\Users\USUARIO\Desktop\ E quando fechar o arquivo Net Use X: /DELETE

@Flávia de Oliveira Batista não se pode simplesmente alterar a extensão do arquivo e esperar que ele fique legível para a nova extensão. No caso do arquivo Word (*.doc), uma opção, seria, a macro abrir o documento e salvar como *.pdf ou *.txt, Outra opção Importar os dados para dentro de uma aba do Excel, e salvar como *.pdf ou *.txt.

Você precisa zipar (compactar) o arquivo. Ou faça upload do arquivo no site por exemplo: http://ge.tt e coloque o link aqui.

Veja se é isso.@Julianapctt procure manter a ordem crescente dos nomes da aba, pois a macro segue esta sequencia de acordo com o que esta configurada (imagem) Despesas.xls

A função que faz este comando, no exemplo que postei é essa: Function sPing(sHost) As String Dim oPing As Object, oRetStatus As Object Set oPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _ ("select * from Win32_PingStatus where address = '" & sHost & "'") For Each oRetStatus In oPing If IsNull(oRetStatus.StatusCode) Or oRetStatus.StatusCode <> 0 Then sPing = "Status code is " & oRetStatus.StatusCode Else sPing = "Pinging " & sHost & " with " & oRetStatus.bufferSize & " bytes of data:" & Chr(10) & Chr(10) sPing = sPing & "Time (ms) = " & vbTab & oRetStatus.ResponseTime & Chr(10) sPing = sPing & "TTL (s) = " & vbTab & vbTab & oRetStatus.ResponseTimeToLive End If Next End Function Cole esta função em um módulo padrão E na célula digite =sPing("192.168.0.1") ou =sPing(A1), referenciando o valor da celula A1 que tenha o ip Ou ainda se preferir chamar a função em uma sub-rotina Sub TestPing() MsgBox sPing("192.168.0.1") End Sub

@Flávia de Oliveira Batista está havendo algum erro no momento de salvar o arquivo me pdf. Repare na msg de erro do adobe que o nome do arquivo esta com duas extensões VRshowtell1R.txt.PDF Seria bom se pudesse disponibilizar sua planilha ou um modelo bem próximo, para analisarmos.

Você pode chamar estes comandos, diretamente no vba. Segue um modelo, veja se consegue adaptar a sua necessidade. Teste de IP.zip

Ao invés de colocar o endereço dá unidade mapeada, não pode referênciar a máquina e usuário onde está o banco. Exemplo \\PC\User\Desktop\Banco.xlsx

Segue o link http://ge.tt/4JqPrXp2