Ir ao conteúdo
  • Cadastre-se

Basole

Membros Plenos
  • Total de itens

    1.603
  • Registro em

  • Qualificações

    0%

Reputação

736

Sobre Basole

  • Data de Nascimento 01/02/1974 (45 anos)

Informações gerais

  • Cidade e Estado
    Sampa
  • Sexo
    Masculino
  1. @Luan Teles desculpe, mas não entendi. No seu arquivo(exemplo) , não vi formula e está funcionando perfeitamente!
  2. Veja se é isso que deseja: Option Explicit Sub GetFileNames() Dim rowB As Long: rowB = 2 Dim rowC As Long: rowC = 3 Dim xDirect, xFname, InitialFoldr InitialFoldr = "C:\" With Excel.Application.FileDialog(msoFileDialogFolderPicker) .InitialFileName = Excel.Application.DefaultFilePath & "\" .Title = " Selecione o Aquivo " .InitialFileName = InitialFoldr .Show If .SelectedItems.Count <> 0 Then xDirect = .SelectedItems(1) & "\" xFname = VBA.Dir(xDirect, 7) Do While xFname <> "" Range("B" & rowB) = xFname Range("C" & rowC) = xDirect rowB = rowB + 1 rowC = rowC + 1 xFname = VBA.Dir Loop End If End With End Sub
  3. Basole

    Visual Basic VBA Excel (Print Screen)

    Sem usar Api, uma opcao é atraves de Excel, exemplo: Sub Salvar_PrintScr_como_Png() Dim objGraf As Chart Dim paint Set objGraf = Charts.Add objGraf.Paste objGraf.Export Filename:=ThisWorkbook.Path & "\PrintScnSalvo.png", Filtername:="PNG" Excel.Windows.Application.DisplayAlerts = False objGraf.Delete Excel.Windows.Application.DisplayAlerts = True 'abre o arquivo png paint = VBA.Shell("c:\windows\system32\mspaint.exe " & ThisWorkbook.Path & "\PrintScnSalvo.png", vbMaximizedFocus) End Sub
  4. @Flávia de Oliveira Batista qual o critério de comparacão ?
  5. @Luan Teles veja este exemplo de busca avancada que pesquisa em todas as colunas com dados. Controle de Processos.zip
  6. Utilizando o seu arquivo como exemplo, acrescentei no assunto, o nome da empresa e o anexo* Quanto a assinatura voce pode personalizar a sua assinatura no próprio Outlook ou ver as dicas neste link: https://www.rondebruin.nl/win/s1/outlook/signature.htm * Altere o caminho (diretorio), se necessário e NOME E EXTENSAO DO ARQUIVO que sera enviado. PLANILHA 01_Envia_E-mail_1.zip
  7. @Car36 veja se este exemplo:
  8. @Ileusis Luna Ja esta vinculado, feche o arquivo e abra novamente e vera que aumentara para +1
  9. @Ileusis Luna veja se esta sugestao em vba lhe atende. Para armazenar a contagem de incremento da autonumeracao é necessario um arquivo texto que esta definido para ficar na mesma pasta do arquivo Word. Ao abrir o arquivo word, o campo autonumeracão, incrementará para + 1 * Para a autonumeracào iniciar a partir de 1 por exemplo, edite o arquivo Autonure.txt e coloque na linha oNum = 0 Nota_debito_center.zip
  10. Basole

    Visual Basic Excel Formato de CPF

    Segue sugestào em vba. Cole o codigo abaixo no modulo da respectiva aba. Ao digitar um numero de cpf na coluna A a macro verifica e converte no formato CPF. Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 1 Or _ Target.Count > 1 Then Exit Sub Target.NumberFormat = "General" Target.Interior.ColorIndex = xlNone numCPF = Target.Value numCPF = VBA.Replace(numCPF, ".", "") numCPF = VBA.Replace(numCPF, "-", "") If VBA.Val(numCPF) = 0 Or validaCPF(numCPF) <> "OK" Then Target.Interior.ColorIndex = 3 Exit Sub Else Target.Value = VBA.Left(numCPF, 3) & "." & _ VBA.Mid(numCPF, 4, 3) & "." & _ VBA.Mid(numCPF, 7, 3) & "-" & _ VBA.Right(numCPF, 2) End If End Sub E em um modulo padrão, a funcao que verifica se o cpf é valido. Function validaCPF(numCPF) If VBA.Len(numCPF) < 11 Then numCPF = VBA.String(11 - VBA.Len(numCPF), "0") & numCPF For caracter = 1 To 9 DV1 = VBA.Val(Vba.Mid(numCPF, caracter, 1)) * caracter + DV1 If caracter > 1 Then DV2 = VBA.Val(Mid(numCPF, caracter, 1)) * (caracter - 1) + DV2 Next DV1 = VBA.Right(DV1 Mod 11, 1) DV2 = VBA.Right((DV2 + (DV1 * 9)) Mod 11, 1) If VBA.Mid(numCPF, 10, 1) = DV1 And VBA.Mid(numCPF, 11, 1) = DV2 Then validaCPF = "OK" End Function fonte da funcao valida...: http://twixar.me/tPbT
  11. Basole

    Visual Basic RESOLVIDO Impressão de Páginas Personalizada

    @Andril sim mas é qual seria ? Acho melhor abrir novo tópico.fica melhor para futuras pesquisas
  12. @DavidsonGomes1998 veja se é isso Private Sub Btn_Preencher_Click() Dim List As ListItem Dim sql As String ConectDB On Error GoTo trat_err sql = "SELECT [CodProduto],[Produto], SUM([Quant]) AS tl_Quant, SUM([SubTotal]) AS tl_SubTotal " sql = sql & "FROM [tb_venda_p] " sql = sql & "WHERE [Quant] IS NOT NULL " sql = sql & "GROUP BY [CodProduto],[Produto];" rs.Open sql, db, 3, 3 Me.ListView1.ListItems.Clear While Not rs.EOF Set List = Me.ListView1.ListItems.Add(Text:=rs!CodProduto) List.SubItems(1) = rs!Produto List.SubItems(2) = rs!tl_Quant List.SubItems(3) = VBA.Format(rs!tl_SubTotal, "#,##0.00") rs.MoveNext Wend trat_err: FechaDb End Sub
  13. Para que sua demanda seja atendida, sugiro que disponibilize exemplo da sua planilha e do banco de dados com alguns dados fictícios.
  14. @Daniela.Dias segue sugestao de envio em massa pelo outlook. Na coluna D insira os enderecos de e-mails validos, dos prestadores. E na celula F1 altere o texto do assunto do e-mail. PLANILHA 01_Envia_E-mail.zip
  15. @Luan Teles fiz as adaptacões no código conforme seu arquivo, veja se é isso.. No arredondamento da temperatura alterei para para cima, anteriormente estava para baixo. No Excel tem dessas coisas ! E nem Bill Gates explica Bom mas eu contornei essa inconsistência, colocando uma rotina para posicionar corretamente de forma automática: * No modulo da sua aba "Resumo Geral"`, cole o código abaixo. E ai quando você ativar essa aba novamente, a macro vai corrigir esse problema. Private Sub Worksheet_Activate() On Error Resume Next With ActiveSheet.Shapes("Icone_Tempo") .Width = [Q2:P2].Width .Height = [P1:Q8].Height .Top = Rows([O1].Row).Top .Left = Columns([P2].Column).Left End With On Error GoTo 0 End Sub .

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações 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...

Aprenda_a_Ler_Resistores_e_Capacitores-capa-3d-newsletter.jpg

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!