Ir para conteúdo
Fórum Script Brasil

Alyson Ronnan Martins

Membros
  • Total de itens

    831
  • Registro em

  • Última visita

Tudo que Alyson Ronnan Martins postou

  1. Boa tarde @coutinhoicaro. Seu código esta um pouco complexo. Teria como mandar uma cópia da planilha, com dados fictícios por exemplo?
  2. Boa tarde @Silvio Lima. Como fica o seu código depois que ele é executado? sql = "Insert into tabela(CodUusario, Nome, Urgente)" & " Values (" & txtCodUsuario.text 7 ", '" & txtNomeUsuario.text & "', " & Checkbox1.value & " )" Exemplo usando debug.print:
  3. Boa tarde @brunopare. Tenta colocar adicionar seguinte parte e testa ai. 'objeto outlook = aplicação outlook, ao definir um objeto para uma variável usamos o Set Set objeto_outlook = CreateObject("Outlook.Application") 'agora só trocar onde temos o número da linha para a variável linha For linha = 2 To 4 Set Email = objeto_outlook.createitem(0) ' cria um item dentro do programa outlook ou seja um novo email dentro do outlook With Email .display ' mostra o email para vermos o que esta acontecendo .SentOnBehalfOfName = "xxxxxxxxxxxxxxxxxxxxxxxx" .To = Cells(linha, "E").Value ' destinatário linha 2 coluna 5 '.cc = "chefe@gmail.com" 'copia '.bcc = "diego@gmail.com" 'copia oculta .Subject = "XXXXXXXXXXX– xxxxxxxxxxxxxxxxxxxxxxxx " & Cells(linha, "C").Value & " OS " & Cells(linha, "A").Value ' Assunto" 'Início do alteração: .BodyFormat = olFormatHTML 'Agora todo o código tem que ser escrito em HTML 'Concatena o item da linha 2, coluna 2 com uma vírgula, Chr(10) = Enter .Body = "<HTML><Body>Prezado(a), " & Cells(linha, "B").Value & Chr(10) & Chr(10) _ & "Segue comunicação de Substituição xxxxxxxxxx da xxxxxxxxxxxxxx " & Cells(linha, "C").Value & "." & Chr(10) _ & "Favor desconsiderar o contato caso já tenha recebido a comunicação." & Chr(10) & Chr(10) _ & "Atenciosamente," & Chr(10) & Chr(10) _ & "Departamento de Operações" & Chr(10) & Chr(10) _ & "Esta é uma mensagem automática, favor não responder este e-mail. " _ & "Para dar sugestões, tirar dúvidas ou obter mais informações sobre os " & _ "serviços prestados ligue xxxxxxx - CENTRAL DE ATENDIMENTO - CALL CENTER ou acesse xxxxxxxxx" & "</Body></HTML>" ' Prezado Fulano 'Anexando arquivo no email Email.Attachments.Add (Cells(linha, "AE").Value) 'Finalmente enviamos o email Email.send End With Next Ai o HTML é mais tranquilo de fazer escrito. Olha se conseguiu entender.
  4. Boa tarde @qqguilhermepp, precisaria um pouco mais do código ou contexto para te ajudar nesse problema ai.
  5. Boa tarde @CEMORAIS, tem alguma erro quando você tenta abrir o arquivo? Verifica o controle adicionais do office se esta desabilitado ou a DLL não esta colocando no computador que não esta abrindo o formulário. Já encontrei erros similares que eram causado pelo office "mal" instalados.
  6. Boa noite. Usando código HTML você consegue formatar o email deixando mais "bonito". Não muda o fato que o resultado é o mesmo, porêm sempre que termino uma código de email VBA (e deixo funcionando) eu já coloco formatação HTML para deixar parecido com uma tabela excel e deixando mais organizado os itens.
  7. Os campos de tabela não fazem cálculos. O jeito de fazer é usando uma consulta, lá pode criar uma coluna com o resultado do cálculo.
  8. Boa noite @Edmar Ferreira Morato Tenta o seguinte: Dim teste as long teste = Eval(campo_formula) '(1*2+35)*100/2) MsgBox "Valor da conta = " & teste Fonte: Microsoft
  9. Eu criei uma lista para simular o preenchimento dos campos e envio do e-mail: Aqui o código: Public Sub cRaquel_Penha() Dim accountArray() As Variant Dim acountName As String Dim acountFirst As Boolean Dim lAcount As Long 'Variáveis para enviar o email: Dim emailTO As String Dim emailCC As String Dim emailBody As String With Sheets("Plan1") lAcount = .Cells(rows.Count, "F").End(xlup).row accountArray = .range("A2:F" & lAcount).Value End With 'Remove as accounts dulplicadas listAccount = ArrayRemoveDups(accountArray) 'Começa a montar a lista de emails olhando para a lista de "accounts" For y = LBound(listAccount) To UBound(listAccount) Step 1 acountName = listAccount(y) acountFirst = True For x = LBound(accountArray) To UBound(accountArray) Step 1 'Procura os dados da a lista If accountArray(x, 6) = accountName Then 'Se for a primeira vez fazer o início do email If acountFirst Then emailTO = accountArray(x, 4) emailCC = "mcacft@hotmail.com" emailBody = "Olá" & Space(1) & Cells(linha, 2).Value & "," & Chr(10) & Chr(10) _ & "Você possui a(s) seguinte(s) fatura(s) em aberto" & Chr(10) & Chr(10) _ & "SerialNfSe Valor do Serviço Link da NFse" & Chr(10) acountFirst = False End If 'Essa parte acho melhor fazer uma tabela 'porém estou seguindo a ideia do código emailBody = emailBody & accountArray(x, 2) & Space(18) & "R$" & accountArray(x, 2) & _ Space(12) & accountArray(x, 5) End If Next x 'Fechando o email. emailBody = emailBody & Chr(10) _ & "Nesse caso, você mesmo pode atualizar seu boleto e atualizar o vencimento, é só acessar o seu Módulo Faturas" & Chr(10) _ & "Atenciosamente," & Chr(10) & "Financeiro" 'Área para envioar o email: 'Coloca seu código aqui 'Final do Envio do email: Next y End Sub Function ArrayRemoveDups(MyArray As Variant) As Variant Dim nFirst As Long, nLast As Long, i As Long Dim item As String Dim arrTemp() As String Dim Coll As New Collection 'Get First and Last Array Positions nFirst = LBound(MyArray) nLast = UBound(MyArray) ReDim arrTemp(nFirst To nLast) 'Convert Array to String For i = nFirst To nLast arrTemp(i) = CStr(MyArray(i, 1)) Next i 'Populate Temporary Collection On Error Resume Next For i = nFirst To nLast Coll.Add arrTemp(i), arrTemp(i) Next i Err.Clear On Error GoTo 0 'Resize Array nLast = Coll.Count + nFirst - 1 ReDim arrTemp(nFirst To nLast) 'Populate Array For i = nFirst To nLast arrTemp(i) = Coll(i - nFirst + 1) Next i 'Output Array ArrayRemoveDups = arrTemp End Function Agora precisa testar ou olhar o código se é mais ou menos isso que estava pensando. Link: Planilha no Google Drive
  10. Isso dessa maneira pode gerar vários problemas mais seria assim. O SQL separa o que é a hora mínima e hora máxima: SELECT id_employee, check_dt, MIN(check_hr) as Entrada, MAX(check_hr) as Saida FROM tb_ponto GROUP BY id_employee, check_dt E quando você for colocar a informação na página só vai aceitar com "Saída" com maior que "Entrada" Teste de SQL: Resultado:
  11. Boa tarde @Antonio Augusto Crovador Quando tentei abrir seu projeto estava protegido.
  12. Boa tarde @Raquel Penha Você já tenho o código para colocar mais de um anexo em email? (não tenho ele) Mais eu, antes de ajudar, quero saber se o objetivo per percorrer a planilha para encontrar o mesmo nome do cliente (ou email) e assim montar um único email.
  13. Boa tarde @Danielgs Não sei se entendi direito seu objetivo: -> Criar uma tabela de dados que antes de cadastrar verifique se teve algum registro anterior e coloca em uma coluna de "2 batida"? -> Pegar os dados existente e tentar montar um consulta de Registro | data | 1 batida | 2 batida?
  14. Bom dia. Tem como mandar o link da planilha oara tentar te ajudar?
  15. Boa tarde @Albino Sergio Como não sei como é seu projeto "exatamente" pode ser que tenha entendi errado. Fiz alteração no código para que quando faça alteração alteração na planilha ela executar o código novamente: Private Sub Worksheet_Change(ByVal Target As Range) cPageSetupCustom End Sub E o código alterei para coluna E (olhando se tem alguma coisa diferente "" na coluna E: Sub cPageSetupCustom() lastRow = 2 rTotal = ActiveSheet.Cells(Rows.Count, "E").End(xlUp).Row For x = rTotal To 2 Step -1 If ActiveSheet.Cells(x, "E").value <> "" Then lastRow = x x = 2 End If Next x 'Range("A1:H" & lastRow).Select ActiveSheet.PageSetup.PrintArea = "$A$1:$H$" & lastRow End Sub Segue o print do código colocando dentro da folha (planilha) que esta o código: Olha se conseguiu entender.
  16. Boa noite. Verifica se agora o erro passa: If Senha = Senha_confirmar Then Msgbox ("ok") Else Msgbox ("senha não compativel") Exit Sub End If Set CPF_repetido = Worksheets("Registro").Cells.Find(CPF) If CPF_repetido Is Nothing Then ElseIf CPF = CPF_repetido Then Msgbox ("Já exise um CPF igual a esse!" + vbCrLf + "Por favor escreva outro") Exit Sub End If Set Login_repetido = Worksheets("Registro").Cells.Find(Login) If Login_repetido Is Nothing Then ElseIf Login = Login_repetido Then Msgbox ("Já exise um login igual a esse!" + vbCrLf + "Por favor escreva outro") Exit Sub End If linha = Sheets("Registro").Range("A1").End(xlDown).Row + 1 'planilha registro, celula A1, usar Ctrl+down ultima celula + 1 (contando)) Sheets("Registro").Cells(linha, 1) = Login.Value Sheets("Registro").Cells(linha, 2) = CPF.Value Sheets("Registro").Cells(linha, 3) = Senha.Value If Botão_homem.Value = True Then Sheets("Registro").Cells(linha, 4) = "Homem" Else Sheets("Registro").Cells(linha, 4) = "Mulher" End If Unload Cadastro 'fechar formulario Msgbox ("Cadastro bem sucedido")
  17. Boa noite Olha se assim ele seleciona e define a área de impressão Sub cPageSetupCustom() lastRow = 2 rTotal = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row For x = rTotal To 2 Step -1 If ActiveSheet.Cells(x, "A").value <> "" Then lastRow = x x = 2 End If Next x Range("A1:H" & lastRow).Select ActiveSheet.PageSetup.PrintArea = "$A$1:$H$" & lastRow End Sub
  18. Bom dia! Tenta da seguinte maneira: Private Sub CommandButton1_Click() 'Adiciona os itens no ListView Dim guia as Worksheets Set guia = sheets(ComboBox.value) 'Set guia = ComboBox ' aqui quero mudar o valor da variável conforme o combobox são 25 planilhas, se eu tirar a combo e digitar o nome da planilha funcionar sem problemas, mas como são muitas eu teria que fazer 25 formulários e eu acho que tem uma solução, só não conseguir resolver, espero que alguém me ajude. uLinha = guia.Cells(guia.Cells.Rows.Count, "a").End(xlUp).Row lsLista.ListItems.Clear For x = 2 To uLinha Set li = lsLista.ListItems.Add(Text:=guia.Cells(x, "a").Value) li.ListSubItems.Add Text:=guia.Cells(x, "b").Value li.ListSubItems.Add Text:=guia.Cells(x, "c").Value li.ListSubItems.Add Text:=guia.Cells(x, "d").Value li.ListSubItems.Add Text:=guia.Cells(x, "e").Value Next End Sub Obs: escrevi do celular então worksheets pode ser que seja worksheet. Testa o código e vê se deu certo.
  19. Troca essa parte: 'atual Range(selecao1, selecao2).Select 'proposta Range(selecao1 & " ," & selecao2).Select
  20. Ainda não entendi kkkkk Quando você diz loop é de duas em duas colunas? ou até ter conteúdo? ou ver qual o maior numero de linhas dentre essas colunas?
  21. Bom dia. Então mudamos o variável L para coluna 😄 Dim l As Long l = ActiveSheet.cells(rows.Count, "C").end(xlup).row Range("A1:A" & l & ",C1:C" & l).Select
  22. Estão ficaria assim para saber qual a última linha: Dim l As Long l = ActiveSheet.cells(rows.Count, "A").end(xlup).row Range("A1:A" & l & ",C1:C" & l).Select
  23. Boa noite @drreis Eu não sei se é uma seleção dinâmica porém o código abaixo é uma seleção estática: Range("A:A,C:C").Select Podendo também ser assim: Range("A1:A10,C1:C10").Select
  24. Bom dia @leoamsousa! Tenta da seguinte maneira: Sub Cabecalho() Dim ws As Worksheet For Each ws In Worksheets ws.select Rows("1:2").Select Selection.Replace What:="Budget_2021\Budget_2021\[Template BGT 2021.xlsx", _ Replacement:="Budget_2022\Budget_2022\[Template BGT 2022.xlsx", LookAt:= _ xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Next End Sub
×
×
  • Criar Novo...