Ir ao conteúdo

Basole

Membro Pleno
  • Posts

    2.009
  • Cadastrado em

Tudo que Basole postou

  1. Tente formatar com formulas: =DIA(A1)&"/"&PRI.MAIÚSCULA(TEXTO(A1;"mmm")&"/"&ANO(A1)) ou =DIA("11/09/2016")&"/"&PRI.MAIÚSCULA(TEXTO("11/09/2016";"mmm")&"/"&ANO("11/09/2016"))
  2. Click com o boato direito sobre o nome da aba [CADASTRO DE ATENDIMENTO] e selecione a opção exibir codigo, para ver a macro. EXEMPLO_14-09.zip
  3. Quando se compartilha uma pasta de trabalho, fica sem acesso as macros. Teria que "descompartilhar" fazer as alteracoes, em seguida compartlhar novamente.
  4. @DANILOMAGALHAES segue em anexo com as alteraçoes solicitadas. Ao alterar algum valor na coluna "D" a macro diminui automaticamente o valor do respect. item, da coluna "D" (saida) da aba Estoque. Cópia de EXEMPLO_14-09.zip
  5. @nataliabenassi tente essas opções : http://www.access-programmers.co.uk/forums/showthread.php?t=210883&highlight=MaxLocksPerfile ou http://www.usandoaccess.com.br/tutoriais/configurando-opções-do-access-pelo-setoption.asp?id=1#inicio para office 64 http://teknorapor.com/access-2013-dosya-paylasim-kilidi-sayisi-asildi-uyarisi/
  6. @Bruno Tardivo seja bem vindo ao forum!. Acredito que esses numeros sejam antigos pois os atuais possuem o prefixo 9_ ou seja 9 digitos. Segue opção de udf que remove caracteres. Faça uma analise na sua lista de numeros para ver se possuem algum caracter nao citado acima. Caso o numero de digitos seja < (menor) que 10 a função retornará como: " " (vazio) Utilize desta forma na sua planilha. Ex.: =SE(A2<>"";Remove_Cararc(A2);"") Cole o codigo abaixo em um modulo padrão. Const SpecialCharacters As String = "/,-,.,;" Function Remove_Cararc(rng As Range) As String Dim myString As String Dim newString As String Dim char As Variant myString = rng newString = myString For Each char In VBA.Split(SpecialCharacters, ",") newString = VBA.Replace(newString, char, " ") Next newString = VBA.Replace(VBA.Replace(newString, " ", ""), ",", "") If VBA.Len(newString) < 10 Then Remove_Cararc = Empty: Exit Function Remove_Cararc = VBA.IIf(VBA.Left(newString, 1) = 0, VBA.Right(newString, VBA.Len(newString) - 1), newString) End Function
  7. @Robson Barros poste seu exemplo por favor.
  8. Segue minha opção com formula matricial. Preenchimento automatico conforme tipo de documento_1.xlsx
  9. @Diego Dias Alano da forma que voce quer fazer o autoFiltro até irá funcionar, mas a opçõa Classificar vai depender de se as celulas que deseja classificar poderão ficar desprotegidas, caso contrario esta opção ficará disponivel, mas o excel apresentará msg que as celulas estão bla bla bla..... Veja o exemplo: Private Sub Workbook_Open() Dim sheet As Worksheet Const Senha As String = "12345**" For Each sheet In Worksheets On Error Resume Next With sheet .Protect Senha, AllowFiltering:=True, AllowSorting:=True .EnableSelection = xlUnlockedCells End With Next End Sub
  10. @COMPRADOR tente.. as alteraçoes dessas linhas: Dim eng as string eng = Vba.Format(Me.txt_buscaeng.Value, "####") If vba.Trim(consulta("eng").Value) = Vba.Trim(eng) Then
  11. @Adriano Delvali Eu mantive as duas pesquisas... Se o campo Palavra Chave estiver vazio a macro pesquisará pelo campo Codigo, caso contrario pela palavra chave Laudo de Análise - Garantia da Qualidade_3.xls
  12. Não entendi.. voce quer inserir o codigo na celula [ palavra chave ] e pesquisar pelo codigo ?
  13. Utilizei como exemplo a celula M1. Se a celula m1 estiver preenchida a macro utiliza esta celula como texto, caso contrario utiliza o texto "Bom dia", à tarde "Boa tarde" e à noite "Boa noite" Letreiro_2.xlsm (28.71KB)
  14. Sim é possivel. Veja este exemplo: Letreiro.xlsm
  15. Tente referenciar ActiveSheet a Thisworkbook: Ex.: With Thisworkbook .ActiveSheet.... .ActiveSheet.... End With
  16. Segue alteraçoes veja se atende: Sub PESQUISA() ' ' PESQUISA Macro Dim pega As String, cr As Integer, rng As Range, i As Long Sheets("CADASTRO").Activate Range("D23").Activate ActiveCell.Activate pega = ActiveCell.Value If pega = "" Then MsgBox "INFORME UMA PALAVRA CHAVE!!!", , "PESQUISA" Exit Sub End If Sheets("insumos").Activate cr = 0 rng = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row For i = 3 To rng Step 1 'aqui você não precisa informar o nome completo 'mas corre o risco de ficar em duplicidade If VBA.Trim(ActiveSheet.Cells(i, 3).Value) = VBA.Trim(pega) Then Cells(i, 3).Copy Range("CADASTRO!D23").PasteSpecial (xlPasteValues) Application.CutCopyMode = False Cells(i, 2).Copy Range("CADASTRO!D24").PasteSpecial (xlPasteValues) Application.CutCopyMode = False Cells(i, 1).Copy Range("CADASTRO!D25").PasteSpecial (xlPasteValues) Application.CutCopyMode = False Sheets("CADASTRO").Select cd = Range("D24").Value pergunta = MsgBox("Insumo Encontrado!" & _ Chr(13) & "É possível que haja outros INSUMOS com a mesma palavra chave," & _ Chr(13) & "quer continuar a busca por outros insumos?" & Chr(13) & _ "Código do Insumo: " & cd, _ vbYesNo, "PESQUISA") If pergunta = vbNo Then Sheets("CADASTRO").Select MsgBox "Fim da Pesquisa!", , "PESQUISA" Exit Sub Else 'Atenção com esta linha para alteração 'o loop pode mudar de direção Sheets("insumos").Activate End If cr = cr + 1 End If Next i If cr = 0 Then Sheets("CADASTRO").Select MsgBox "Insumo não Cadastrado!", , "PESQUISA" Else Sheets("CADASTRO").Select MsgBox "Fim da busca, nº de insumos encontrados: (" & cr & ")", , "" End If End Sub
  17. Não tenho certeza, mas acho que tem que alterar o status do titulo do topico, em editar titulo e altere o status para "resolvido" obrigado.
  18. @deejaywesley aqui pra mim funcionou perfeitamente (de acordo com as informações passadas no seu 1º post) Segue o exemplo.: Transpor_Cell_Col_.zip
  19. @danielcastrro só complementando o que @deejaywesley sugeriu. Insira para formato "*.xls", FileFormat:=56 wbNew.SaveAs "C:\Users\DC\Desktop\Nova pasta (2)" & "\" & "Encomenda" & "\" & Range("Z2") & ".xls", FileFormat:=56
  20. Sim, segue exemplo: Coloque um botão para executar a macro ou um atalho de teclado Private Sub Habilita_Acesso_Projeto() Dim snh As String snh = InputBox("Digite a senha de liberação", "Acesso ao Projeto") If snh = "" Then Exit Sub If snh = "SuaSenha" Then ' * Altere aqui a senha With ThisWorkbook .Application.OnKey "%{F11}" .Application.ShowDevTools = True End With Else MsgBox "Senha invalida!", vbCritical, "Verifica Senha" End If End Sub
  21. @deejaywesley veja se é isso que precisa. Sub Transpor_Cell_Col_Basole() Dim i As Long, x As Long, strArray() As String, MyArray As String With ThisWorkbook.ActiveSheet For x = 2 To 15 MyArray = .Cells(x, 2).Text strArray = Split(MyArray, "-") For i = LBound(strArray) To UBound(strArray) ThisWorkbook.Sheets("plan2").Cells(x, i + 7).Value = strArray(i) Next i Next x .Range("B2").ClearContents ThisWorkbook.Save End With End Sub
  22. @Diego Dias Alano o caminho seria desabilitar todos o atalhos de acesso as propriedades do projeto. O atalho de teclado (Alt+F11) e tambem a guia "Desenvolvedor" na Faixa personalizada (ou barra de Ferramentas se preferir) do excel (vide img1) img1 Segue exemplo codigo: * Cole no modulo de EstaPsta_de_trabalho. (vide img2) Private Sub Workbook_Open() ' Desabilita With ThisWorkbook .Application.OnKey "%{F11}", "" .Application.ShowDevTools = False End With End Sub Private Sub Workbook_Deactivate() ' Habilita With ThisWorkbook .Application.OnKey "%{F11}" .Application.ShowDevTools = True End With End Sub
  23. @Diego Dias Alano coloque uma senha no VBAProject para usuario não poder acessar esta area. (vide img). 1º Passo: 2º Passo:
  24. Sim tem como, mas com uso de dll (anexo), pois desconheço que o excel tenha este recurso. O problema de usar a dll é que o recurso só ira funcionar na maquina que voce instalou. Alem do problema que citei tem outros inconvenientes que poderá encontrar. O idela seria se voce inserise o seu Botao (CommandButton) na 1ª linha por exemplo, e usar o recurso "congelar paineis" para que o botão ficasse visivel quando. voce utilizasse o scroll do mouse para baixo por exemplo Botao_Flutuante_2.zip Como instalar um DLL ? Como Instalar um DLL 2 ?
  25. Segue (anexo) o exemplo na planilha: botao Flutuante.zip

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...

LANÇAMENTO!

eletronica2025-popup.jpg


CLIQUE AQUI E BAIXE AGORA MESMO!