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. Bom dia @Maicon Basso dos Santos Você quer copiar quando mudar o nome ou realmente a cada 35 linhas?
  2. Bom dia. Fiz sem código direto do userform: Planilha macro
  3. Boa tarde @joaopaulocaetano Tem várias maneiras, uma das maneiras que uso é para identificar a ultima linha preenchida. ultimaLinha = Sheets("Sua planilha").cells(Rows.count, "A").end(xlup).row
  4. Você já usou um accdr? ou alguma maneira de segurança para seu sistema access?
  5. Boa tarde @mmo515 Não entendi a necessidade de usar VBA para adicionar um combobox com um dado do formulário. A maneira mais simples é adicionar um combobox e nele você selecionar os dado de outra tabela. Olha se conseguiu entender, se não conseguir posso te ajudar as 18:00. Aguardo.
  6. Boa tarde @Renato Knupp Eu pesquisei e encontrei o seguinte artigo: Tens de incluir a imagem e escondê-la. A posição 0 vai adicioná-la e escondê-la, o 1 é a constante do Outlook olByValue. .Attachments.Add FILENAME, 1, 0 Assim que adicionares a imagem tens de utilizar a src como src="cid:FILENAME.jpg". Experimenta adicionar esta linha: .Attachments.Add "G:\SETOR DE CADASTRO\WELLINGTON\SIGN.jpg", 1, 0 E no html: .HTMLBody = Email_Body & "<html><body><img src='cid:SIGN.jpg'></body></html>" Fonte: Link
  7. Bom dia @rodrigo21sf Você teria como mandar uma planilha com o userform (mesmo com dados fictícios).
  8. Bom dia @Laiza dos Santos Mendes Podemos fazer essa "ocultação de varias maneira" a que eu mais uso é o For para fazer um loop passando por todas as linhas e ocultando elas. Exemplo: Public Sub cOcultarLinhas() Dim Coluna As Long Dim ultimaLinha As Long Dim charLeft As String Coluna = 3 'Coluna "C" ultimaLinha = ActiveSheet.Cells(Rows.Count, Coluna).End(xlUp).Row 'Pegar a ultima linha da coluna For r = 1 To ultimaLinha charLeft = Left(ActiveSheet.Cells(r, Coluna).Value, 2) 'As duas primeiras letra If charLeft = "06" Or charLeft = "07" Or charLeft = "10" Or charLeft = "17" Then 'Se uma das opções forem corretas ele vai ocultar a linha ActiveSheet.Rows(r).EntireRow.Hidden = True End If Next r End Sub
  9. Bom dia @Matheus06 Tenta fazer um loop para ele sozinho identificar quantas e quais folha tem sua planilha, abaixo eu fiz um exemplo como ficaria fazer um loop pela planilha que tenho o nome sequência "01", "02, "05" ... e uma função para verificar se a planilha existe: Public Sub FiltrarDados() 'Variáveis Dim i As Long Dim Folha As String 'Desativar animações e calculos para macro ser mais rápida Application.ScreenUpdating = False Application.Calculation = xlCalculationManual 'Loop para fazer formatação For i = 1 To 20 Folha = Format(i, "00") If CheckSheet(Folha) Then 'Se existir a planilha fazer a formatação padrão Sheets(Folha).Select Columns("J:P").Select Selection.AutoFilter ActiveSheet.Range("$J$1:$P$3000").AutoFilter Field:=1, Criteria1:="=" Columns("O:P").Select Selection.EntireColumn.Hidden = False Range("A1").Select End If Next i 'Ativar animações e calculos Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Calculate End Sub Função para chegar se a folha existe: Function CheckSheet(pName As String) As Boolean 'Updateby20140617 'fonte: https://pt.extendoffice.com/documents/excel/1743-excel-check-if-a-sheet-exists.html#:~:text=Salve%20este%20c%C3%B3digo%2C%20volte%20para,na%20pasta%20de%20trabalho%20atual. Dim IsExist As Boolean IsExist = False For i = 1 To Application.ActiveWorkbook.Sheets.Count If Application.ActiveWorkbook.Sheets(i).Name = pName Then IsExist = True Exit For End If Next CheckSheet = IsExist End Function Como não tenho nenhuma planilha como exemplo não consigo simular em seus dados. Verificar se deu certo, se não tiver consigo tenta colocar uma planilha com dados fictícios dentro do google drive e compartilha o link para fazer o teste do código na minha máquina.
  10. Boa tarde @sanderba Você pode usar o seguinte comando para gerar o arquivo PDF apartir de uma planilha: Sheets("Sua planilha").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "C:\forum\Pasta1.pdf", Quality:=xlQualityStandard, IncludeDocProperties:= _ True, IgnorePrintAreas:=False, OpenAfterPublish:=True
  11. Boa noite @victorhco Faltou apenas a letra r: Words.SaveAs xFolderPath & "\" & xFileName & ".PDF" '(Nessa parte ta dando erro) Words.SaveAs xFolderPath & "\" & xFileName & ".PDF" '(Nessa parte ta dando erro) Verifica se deu certo
  12. Que bom Rodrigo, sorte e força na jornada.
  13. Boa noite @rodrigo21sf Pegando a sua necessidade eu fiz um código, adaptando a maneira de ler um arquivo txt, e conseguir fazer o seguinte código e tela: Ao abrir o formulário ele carregar as informações do arquivo .ini: Public Sub carregarNomes() Dim LocalArquivo As String Dim LinhaArquivo As String Dim Categoria As String LocalArquivo = ThisWorkbook.Path & "\nomes.ini" If Dir(LocalArquivo) <> "" Then Open LocalArquivo For Input As #1 Do While Not EOF(1) Line Input #1, LinhaArquivo If Left(LinhaArquivo, 1) = "[" And Right(LinhaArquivo, 1) = "]" Then Categoria = Replace(Replace(LinhaArquivo, "[", ""), "]", "") Else Select Case Categoria Case "Meninos" frmPrincipal.ComboBox1.AddItem LinhaArquivo Case "Meninas" frmPrincipal.ComboBox2.AddItem LinhaArquivo Case "Neutros" frmPrincipal.ComboBox3.AddItem LinhaArquivo End Select End If Loop Close #1 End If End Sub Link arquivo: planilha
  14. Boa noite, como você mandou um print mostrando (mais ou menos) como deve ser a planilha eu fiz o seguinte código: Public Sub btAcress_Click() Dim valorNovo As Long valorNovo = ActiveSheet.Range("K3").Value btAtualizarDatas valorNovo End Sub Public Sub btDecress_Click() Dim valorNovo As Long valorNovo = ActiveSheet.Range("K3").Value * -1 btAtualizarDatas valorNovo End Sub Public Sub btAtualizarDatas(Valor As Long) Dim planilhaNome As String Dim x As Long Dim ultimaLinhaPlanilha As Long planilhaNome = "Simulação" With Sheets(planilhaNome) ultimaLinhaPlanilha = .Cells(Rows.Count, "D").End(xlUp).Row For x = 2 To ultimaLinhaPlanilha If .Cells(x, "D").Value <> "" Then .Cells(x, "D").Value = .Cells(x, "D").Value + Valor End If Next x End With End Sub Planilha para download e teste Vídeo mostrando a planilha: vídeo Avalia esse código.
  15. Uma dúvida, todos os dias devem ser alterados na coluna ou apenas o selecionado no formulário?
  16. Boa noite @Leandro Moreno Você tem algum print mostrando mais ou menos como deseja essa função? Pensando que as informações vão esta dentro de um formulário pensei na seguinte possibilidade: Formulário: Código: Private Sub btAcress_Click() Dim x As Double x = CVDate(tData) x = x + tDias tResultado.Value = Format(x, "DD/MM/YYYY") End Sub Private Sub btDecress_Click() Dim x As Double x = CVDate(tData) x = x - tDias tResultado.Value = Format(x, "DD/MM/YYYY") End Sub
  17. *Outra correção: Notei que o SQL que faz o cadastro estava com uma palavra errada "TO usuarios" mudei para "INTO usuarios": $sql = $pdo->prepare("INSERT INTO usuarios (nome, email, senha, situacoe_id, niveis_acesso_id, created, modified) VALUES (:n, :a, :p, :s, :n, :c, :m)"); usuarios.php <?php Class Usuario { private $pdo; public $msgErro = ""; public function conectar($nome, $host, $usuario, $senha) { global $pdo; try { $dsn = 'mysql:host=' . $host . '; dbname=' . $nome; $options = [PDO::MYSQL_ATTR_INIT_COMMAND => 'SET NAMES UTF8']; $pdo = new PDO($dsn, $usuario, $senha, $options); } catch(PDOException $e) { $msgErro = $e->getMessage(); } } public function cadastrar($nome, $email, $senha)//, $situacoe_id, $niveis_acesso_id, $created, $modified) { global $pdo; $sql = $pdo->prepare("SELECT id FROM usuarios WHERE email = :e"); $sql->bindValue(":e",$email); $sql->execute(); if($sql->rowCount() > 0) { return false; } else { $created = date('d/m/y'); $modified = date('d/m/y'); $sql = $pdo->prepare("INSERT INTO usuarios (nome, email, senha, situacoe_id, niveis_acesso_id, created, modified) VALUES (:n, :a, :p, :s, :n, :c, :m)"); $sql->bindValue(":n",$nome); $sql->bindValue(":a",$email); $sql->bindValue(":p",md5($senha)); $sql->bindValue(":s",1); $sql->bindValue(":n",1); $sql->bindValue(":c",$created); $sql->bindValue(":m",$modified); $sql->execute(); return true; } } public function logar($email, $senha) { global $pdo; $sql = $pdo->prepare("SELECT id FROM usuarios WHERE email = :e AND senha = :p"); $sql->bindValue(":e",$email); $sql->bindValue(":p",md5($senha)); $sql->execute(); if($sql->rowCont() > 0) { $dado = $sql->fetch(); session_start(); $_SESSION["id"] = $dado["id"]; return true; } else { return false; } } } ?>
  18. Bom dia @Edilson Santiago Quando fui fazer o teste aqui notei que você colocou variáveis para o comando INSERT no SQL: $sql = $pdo->prepare("INSERT TO usuarios ($nome, $email, $senha, $situacoe_id, $niveis_acesso_id, $created, $modified) VALUES (:n, :a, :p, :s, :n, :c, :m)"); Eu troquei, para os possíveis nomes da tabela, ficando dessa maneira: $sql = $pdo->prepare("INSERT TO usuarios ('nome', 'email', 'senha', 'situacoe_id', 'niveis_acesso_id', 'created', 'modified') VALUES (:n, :a, :p, :s, :n, :c, :m)"); Essa alteração mostrou que o cadastra precisava de mais parâmetros para realizar a função. Olha se essas observações te ajudam.
  19. Bom dia @Anderson Aragão Tenta colocar essa alteração: llinha = validadores.Cells(validadores.Rows.Count, 1).End(xlUp).Row + 1
  20. Bom dia @piasserpa Fiz uma simulação do código que estava precisando, olha se é dessa maneira. Public Sub cPiasserpa() Dim sh(1 To 2) As Worksheet Set sh(1) = Sheets("Gráfico_SDemand_22") Set sh(2) = Sheets("Targets") If sh(1).Range("D3").Value = sh(2).Range("A3").Value Then sh(1).Range("D6").Value = sh(1).Range("B27").Value End If End Sub Link: Planilha no Onedrive
  21. Bom dia. Um código ou um arquivo com o VBA. sem ver seu código não consigo te auxiliar a fazer.
  22. Boa tarde @ivinnas Dá sim para fazer uma repetição de emails assim enviando o anexo cliente 1 para o cliente 1. Primeiro você tem um exemplo do seu código, com dados fictícios para tentar de ajudar mais diretamente?
  23. Boa noite @Anderson Aragão Eu fiz um simulei seu código e vi que estava com erro justamente no, código abaixo, na teste que fiz não pode ter o divisor com o numero zero. txtcalculada.Text = ((cheia - vazia) / pesomedio) Para solucionar fiz uma "IIF" (mesma coisa que "SE") e troquei o "" para 1 quando não tiver nada: Sub calcular() Dim vazia As Double Dim cheia As Double Dim pesomedio As Double Dim maximocaixa As Double Dim preforma As Double With frmAnderson preforma = IIf(.txtpreforma.Text = "", 0, .txtpreforma.Text) vazia = IIf(.txtvazia.Text = "", 0, .txtvazia.Text) cheio = IIf(.txtcheia.Text = "", 0, .txtcheia.Text) pesomedio = IIf(.txtpesomedio.Text = "", 1, .txtpesomedio.Text) maximocaixa = IIf(.txtmaximocaixa.Text = "", 0, .txtmaximocaixa.Text) 'If .txtpreforma.Text <> "" Then preforma = .txtpreforma.Text 'If .txtvazia.Text <> "" Then vazia = .txtvazia.Text 'If .txtcheia.Text <> "" Then cheia = .txtcheia.Text 'If .txtpesomedio.Text <> "" Then pesomedio = .txtpesomedio.Text 'If .txtmaximocaixa.Text <> "" Then maximocaixa = .txtmaximocaixa.Text .txtesperado.Text = (preforma * maximocaixa) .txtcalculada.Text = ((cheia - vazia) / pesomedio) .txtdiferença.Text = (maximocaixa - calculada) End With End Sub Link Planilha com o exemplo
×
×
  • Criar Novo...