Ir ao conteúdo
  • Cadastre-se

Edson Luiz Branco

Membro Pleno
  • Posts

    840
  • Cadastrado em

  • Última visita

Tudo que Edson Luiz Branco postou

  1. Pois é, @jacinto_arq , pelo que vi não há áudio nenhum em seus arquivos. O que está anexado são pictures (imagens), só os ícones mesmo. Talvez no momento de incorporar os áudios nos documentos, tenha sido feito de forma errada (copiar e colar simples, por exemplo). você pode confirmar isso criando um pequeno módulo no VBA da seguinte forma: Sub MostraTipoDoConteúdoIncorporado() With ActiveDocument.InlineShapes(1) Select Case .Type Case wdInlineShapeEmbeddedOLEObject MsgBox "O conteúdo incorporado é um objeto OLE (som, mídia,..., etc.)" Case wdInlineShapePicture MsgBox "O conteúdo incorporado é uma simples figura" Case Else MsgBox "Outro tipo de conteúdo" End Select End With End Sub
  2. Bom dia, @jacinto_arq você já experimentou simplesmente clicar selecionando o áudio no Word, copiar para a área de transferência (CTRL+C) e abrir a pasta em que você quer colar o arquivo no Windows Explorer e dar CTRL+V? Dá até mesmo para fazer isso simplesmente arrastando ele para a pasta.
  3. Não deveria. Como você está fazendo? O correto seria: Antes de iniciar a seleção, mantenha o cursor já na primeira célula que pertencerá à seleção. Pressione SHIFT+F8 e solte totalmente (esqueça dela até o final da seleção) Selecione as outras células únicas ou intervalos, adjacentes ou não adjacentes Quando terminar a seleção, pressione novamente SHIFT+F8
  4. Bem vindo ao Fórum Clube do Hardware, @JOAOMORAES83 Num módulo qualquer, cole a seguinte UDF: Function ExcluiNúms(txt As String) As String With CreateObject("VBScript.Regexp") .Global = True: .Pattern = "\d" ExcluiNúms = .Replace(txt, "") End With End Function Para usar: se na A1 estiver 0123456789abcdefg, na célula que você quer o resultado, use a fórmula: =ExcluiNúms(A1) ou =ExcluiNúms("0123456789abcdefg")
  5. @dapalma , bom dia. Mesmo sem usar variável você estava quase lá. você acertou quando qualificou o objeto Range em Worksheets("Plan1").Range(...). O único erro é que você deveria ter feito isso também quando usou Cells(...). Como você não usou qualificador, quando ocultou a planilha por ela não estar ativa ocorreu erro. Pra usar com planilhas ocultas/não ativas use: Worksheets("Plan1").Cells(...) ou Plan1.Cells(...) ou ainda With Worksheets("Plan1"): .Range(.Cells(...)...): End With. Então seu código poderia ser: Sub Classificar() With Worksheets("Plan1") .Range(.Cells(1, 1), .Cells(30, 1)).Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal End With End Sub
  6. @FSoares.FCS , boa noite. Faça um teste numa cópia de seu workbook: Sub CriarCCusto() Dim wsCC As Worksheet, ws As Worksheet, rg As Range, i As Integer Dim ListaCriadas As String With ThisWorkbook Set wsCC = .Worksheets("Centro de Custo") Set rg = wsCC.Range("C2", wsCC.Range("C1").End(xlDown)) For i = 1 To rg.Cells.Count On Error Resume Next Set ws = .Worksheets(rg.Cells(i).Value) If Err.Number = 9 Then If i = 1 Then .Worksheets.Add(After:=wsCC).Name = rg.Cells(i).Value ListaCriadas = rg.Cells(i).Value Else .Worksheets.Add(After:=.Worksheets(rg.Cells(i - 1).Value)).Name = rg.Cells(i).Value ListaCriadas = ListaCriadas & vbCrLf & rg.Cells(i).Value End If ElseIf Err.Number > 0 Then Exit Sub End If On Error GoTo 0 Next i End With If ListaCriadas <> vbNullString Then MsgBox "Criada(s) a(s) Planilha(s):" & vbCrLf & ListaCriadas, vbInformation, "LISTA DE CC CRIADOS" Set rg = Nothing: Set wsCC = Nothing: Set ws = Nothing End Sub
  7. Tente isso: Private Sub pesquisar_btn_Click() Const caminho = "\\ln008svr03\processos\Projeto BPF Bonsucesso\10_Recebimento\" Const arquivo = "RO.BN.05_002_Registro de Recebimento 2018.xlsb" Dim arqTemp As Object Dim EmpFound As Range Dim Wb As Workbook Application.ScreenUpdating = False With CreateObject("Scripting.FileSystemObject") If .FileExists(caminho & arquivo) Then .CopyFile Source:=caminho & arquivo, Destination:=caminho & arquivo & "(Cópia)", _ OverWriteFiles:=True Set arqTemp = .GetFile(caminho & arquivo & "(Cópia)") Else Exit Sub End If Set Wb = Workbooks.Open(arqTemp.Path) Wb.Sheets("Registro de Recebimento 2018").Activate '..... '..... '..... '..... Wb.Close SaveChanges:=False arqTemp.Delete True End With Set arqTemp = Nothing: Set EmpFound = Nothing: Set Wb = Nothing End Sub
  8. Bom dia, @diego_janjao Tô estranhando isso que tá acontecendo contigo. Quando você tem um ArquivoA em rede e o Usuário1 na Máquina1 já está com ele aberto e você, Usuário2 na Máquina2 abre-o via macro da maneira que você descreveu, com ReadOnly = True, o arquivo abre normalmente em modo Somente Leitura sem emitir nenhum aviso (testei aqui e rodou assim). Será que o ArquivoA já não estava aberto na sua Máquina2 ?
  9. @SAMUELLOPES , bom dia e vem vindo ao Clube do Hardware As funções ÍNDICE/CORRESP seriam mais apropriadas nessa situação. Mas vejamos o porquê do erro: A função PROCV só procura na primeira coluna do intervalo passado como argumento "matriz_tabela". Note no entanto que seu intervalo nomeado "ENTRADA" não começa na coluna que contém ID DO CONTENTOR (C) mas sim uma coluna antes (B). Então, pra usar PROCV você teria que ou redefinir ENTRADA para começar na coluna C ou, melhor, deslocar o intervalo com a função DESLOC uma coluna à direita: =SE(PROCV(B4;DESLOC(ENTRADA;0;1);1;FALSO);"P";"A") Incrementando para não aparecer erro #N/D quando não houver célula preenchida: =SEERRO(SE(PROCV(B4;DESLOC(ENTRADA;0;1);1;FALSO);"P";"A");"")
  10. @Flávia de Oliveira Batista , boa noite. Uma ideia seria: Sub FiltraMêsAtual() Dim Di As Variant, Df As Variant Di = DateSerial(Year(Date), Month(Date), 1): Df = DateAdd("m", 1, Di) - 1 Di = Format(Di, "mm/dd/yyyy"): Df = Format(Df, "mm/dd/yyyy") ActiveSheet.Range("$A$1:$H$1").AutoFilter Field:=8, Operator:=xlAnd, _ Criteria1:=">=" & Di, Criteria2:="<=" & Df End Sub
  11. @rafaelcamposbr , como você tem o 2016 dá pra usar a fórmulatexto junto com outras funções. basicamente sugiro: =somarproduto(1*(ext.texto(fórmulatexto(a1);lin(indireto("1:"&núm.caract(fórmulatexto(a1))));1)="+"))+1
  12. Qual a versão de seu Excel? Se for 2013 pra frente dá pra fazer através de fórmula (função FÓRMULATEXTO), senão faríamos por VBA.
  13. Boa noite, Uika. Seu arquivo estava num pendrive ou drive externo? É possível que ele tenha ficado corrompido. Faça uma cópia de segurança antes e então tente reparar o arquivo: Clique em Arquivo > Abrir e vá para o local em que a pasta de trabalho Excel está. Clique uma vez só no nome do arquivo para selecioná-lo e então clique na setinha ao lado do botão Abrir Escolha Abrir e Reparar Veja também algumas outras possibilidades em: O que é o Modo de Exibição Protegido
  14. Tens razão, @lHenrique_10 . É que dezembro começa com "de" também, então tem que colocar o espaço após o "de" na fórmula de substituição (a gafe foi minha, perdão ) Corrigindo, fica então: =DATA.VALOR(SUBSTITUIR(A1;"de ";""))
  15. Também dá pra usar a função DATA.VALOR substituindo primeiro a preposição "de" por caractere vazio (ela é que atrapalha a leitura direta). Exemplo, se em A1 está sua data, use: =DATA.VALOR(SUBSTITUIR(A1;"de";""))
  16. Ok, tente o seguinte então: Sub Gerador_Contagem_Click() Dim NúmLinhas As Long: NúmLinhas = Sheets("Cadastro").Range("C5").Value Dim rgCad As Range: Set rgCad = Sheets("Cadastro").Range("A10").Resize(NúmLinhas) Dim rgCtg As Range: Set rgCtg = Sheets("Contagem").Range("A9:A" & _ Sheets("Contagem").Range("A9").End(xlDown).Row) rgCtg.Resize(, 3).Clear rgCad.Copy rgCtg.Cells(1) rgCtg.Parent.Activate Set rgCad = Nothing: Set rgCtg = Nothing End Sub
  17. No último arquivo q você enviou, na planilha Cadastro não há nada na célula A8. Acho que você quis dizer A10 ou você está trabalhando com outra versão do arquivo em casa. Pergunta: na planilha Contagem, na hora de deletar os dados anteriores, é pra deletar só os da coluna A ou também os da B (Venda Bruta) e C (%Venda)?
  18. Boa noite, @Andersom Melari Veja se entendi seu propósito: Gerador de Contagem.zip
  19. @ViniciusNunesT bom dia... Então vamos lá: Sub Rearranjo() 'Define o intervalo de entrada como sendo toda área em volta de A1: Dim rg As Range: Set rg = Worksheets("ENTRADA").[A1].CurrentRegion 'Define início do intervalo de saída: Dim rgSaída As Range: Set rgSaída = Worksheets("SAIDA").Range("A1:E1") 'Define variáveis gerais: rg2 conterá o intervalo de vendas para cada revenda 'i e j servirão para percorrer cada lin/col de rg2 concatenando as strings do Cabeçalho 'com os valores de rg2. NúmLin1 e 2 servem para checar se todo intervalo foi percorrido, 'já que são de células mescladas: Dim rg2 As Range, i As Long, j As Long, NúmLin1 As Long, NúmLin2 As Long 'b é uma variável temporária que conterá a cada passada o valor de cada linha de rg2 'até elas terminarem. Cabeçalho tem o título que irá aparecer antes de todo valor para 'identificá-lo: Dim b, Cabeçalho Cabeçalho = Array("ID: ", "LOCAL: ", "REVENDA: ", "VENDEDOR: ", _ "VENDA " & Trim(rg.Cells(1, 5)) & ": ", "QUANTIDADE " & Trim(rg.Cells(1, 6)) & ": ", _ "VENDA " & Trim(rg.Cells(1, 7)) & ": ", "QUANTIDADE " & Trim(rg.Cells(1, 8)) & ": ", _ "VENDA TOTAL: ", "QUANTIDADE TOTAL: ", "EMAIL: ") 'Reduz rg de tabela inteira para trabalhar somente com a coluna das revendas, já que 'identifica cada agrupamento: Set rg = rg.Coumns(3) 'Verifica quantas linhas há para serem processadas: NúmLin1 = rg.Rows.Count 'Inicia o loop: Do 'Reduz rg para ir descendo toda a coluna C de célula em célula ou, se mesclada, 'o conjunto das mescladas: Set rg = rg.Cells(1).MergeArea 'Verifica: se de fato estão mescladas é porque é uma Revenda: If rg.MergeCells Then 'Pega todo o intervalo de 1 coluna à direita de cada Revenda e com tamanho de 7 'colunas,ou seja, dados das vendas de cada revenda de Vendedor até Total. 'Offset e/ou Resize correspondem à função DESLOC no Excel: Set rg2 = rg.Offset(0, 1).Resize(rg.Rows.Count, 7) 'Pra cada linha dos detalhes de venda de cada revenda: For i = 1 To rg2.Rows.Count 'Pra cada coluna entre Vendedor e Total Quantidade For j = 1 To 7 'Concatena todas as células das 7 colunas do intevalo. Também verifica se é 'a primeira linha, já que é diferente das demais. Também insere 10 espaços em 'branco entre uma informação e outra: b = b & IIf(rg2.Cells(i, j) <> "Total", Cabeçalho(j + 2), "") & rg2.Cells(i, j) & String(10, " ") Next j 'Insere um parágrafo ao final de cada linha b = b & vbCrLf Next i 'Desloca a primeira linha 50 espaços para que Total pareça alinhado com nome vendedor. 'Retira a marca de parágrafo e espaços a mais ao final do conjunto de linhas concatenadas: b = String(50, " ") & Trim(Left(b, Len(b) - 2)) 'Saída dos dados: Insere "ID: " e valor do ID na coluna A: rgSaída.Cells(1).Value = Cabeçalho(0) & rg.Cells(1).Offset(0, -2).Value 'Saída dos dados: Insere "Local: " e valor do Local na coluna B: rgSaída.Cells(2).Value = Cabeçalho(1) & rg.Cells(1).Offset(0, -1).Value 'Saída dos dados: Insere "Revenda: " e valor da Revenda na coluna C: rgSaída.Cells(3).Value = Cabeçalho(2) & rg.Cells(1).Offset(0, 0).Value 'Saída dos dados: Insere os valores concatenados (detalhes das vendas) na coluna D: rgSaída.Cells(4).Value = b 'Saída dos dados: Insere "E-mail: " e valor do Email na coluna E: rgSaída.Cells(5).Value = Cabeçalho(10) & rg.Cells(1).Offset(0, 8).Value 'Posiciona-se na próxima linha para receber a próxima remessa de dados: Set rgSaída = rgSaída.Offset(1, 0) 'Zera a variável para o próximo loop b = Null End If 'Acumula a quantidade de linhas já processadas com as da passada atual: NúmLin2 = NúmLin2 + rg.Rows.Count 'A vantagem do método Offset abaixo é que se houver linhas mescladas, ele avança 'não de uma em uma linha, mas para a próxima linha após o conjunto de linhas mescladas Set rg = rg.Cells(1).Offset(1) 'Testa se já processou todas as linhas: Loop Until NúmLin2 >= NúmLin1 'Ativa a planilha de Saída para exibir o resultado: rgSaída.Parent.Activate 'Esvazia as variáveis objeto Set rg = Nothing: Set rg2 = Nothing: Set rgSaída = Nothing End Sub
  20. Seja bem vindo, @Igor Brenner ! Onde está o restante do código? (Sub...End Sub etc) Mas se o erro aponta para a linha que você indicou, provavelmente é porque o método Find não encontrou nada do que se esperava encontrar (conteúdo de vInd) na coluna 15. Não encontrando nada, retorna Nothing mas você manda selecionar (método Select) esse Nothing, o que dá erro. Para ilustrar, faça um teste com o código abaixo e veja que o erro é o mesmo: Sub Teste() Dim rg As Range Set rg = Nothing rg.Select End Sub
  21. Esse recurso está no menu (guia) Inserir > Tabela Mas qual é a sua dúvida?
  22. Olá, @Danielle Durães , seja bem vinda ao Clube do Hardware! Por favor, dê mais detalhes sobre seu problema: são dois arquivos diferentes? São muitas colunas? Elas permanecerão vinculadas após a concatenação ou permanecerão somente os valores sem as fórmulas? O ideal seria você montar um exemplo, uma amostra do que exatamente você deseja e anexar aqui para que possamos entender melhor sua demanda. Se quiser ir arriscando uma tentativa, a maneira clássica de fazer isso é usando o operador de concatenação & ou a função CONCATENAR. Exemplo: =CONCATENAR(A1:A3;" ";B1:B3) É equivalente a: =A1:A3 & " " & B1:B3 Se A1 = a, A2 = b, A3 = c e B1 = 1, B2 = 2, B3 = 3 ambas as fórmulas acima retornam uma matriz-coluna contendo: a 1 b 2 c 3 Não sei se é por aí seu questionamento...
  23. Então, como o Excel armazena as datas como números normais (quantidade de dias que se passaram desde 01/01/1900), a fórmula primeiro compara HOJE() (que no caso para hoje dá 43223) com os dias e outras células vazias da coluna B. Como estou interessado na data que tenha a menor diferença entre ela e hoje, subtraio uma da outra. Como pode ocorrer de coexistirem datas futuras e passadas na coluna B, o valor da subtração ficaria negativo/positivo respectivamente, por isso o uso da função ABS para certificar-me que a expressão sempre retornará positivo. Caso contrário, a função MÍNIMO retornaria resultados imprevisíveis, pois consideraria sempre os negativos como menores que os positivos, independentemente da diferença para a data do "hoje".

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

×
×
  • Criar novo...

 

GRÁTIS: ebook Redes Wi-Fi – 2ª Edição

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!