Eri França

@Basole Fico agradecido

@Basole Não funciona 100% por ser compartilhado as macros da planilha são limitadas, tentarei a solução do amigo

@Basole Salve amigo, erro meu. minha ideia é transpor a planilha em anexo, que utilizo compartilhada com a portaria de recebimento, para um painel online. agradeço qualquer ajuda Agrupamentos.rar

Saudações a todos! Gostaria da ajuda dos senhores para um painel de acompanhamento de nota fiscais. tenho na minha máquina uma planilha excel compartilhada com o setor de portaria para podermos acompanhar o recebimento de notas fiscais, gostaria de transformar isso em uma Api por exemplo, porém não tenho conhecimento o bastante sobre. por onde devo começar?

@MidoriAgradeço imensamente, funcionou, só resta formatar o tamanho

@Midori Bom dia Midori! coloquei o seu código logo após a parte onde eu defino a dimensão da imagem, porém ele da o erro de Variável não definida para o "Recortar", onde eu errei? With .Parent .Height = tmpImg.Height + margem .Width = tmpImg.Width + margem End With End With Set Recortar = tmpChart.Shapes("chart") Recortar.PictureFormat.Crop.PictureOffsetY = -100 Recortar.PictureFormat.Crop.ShapeHeight = 300 Recortar.PictureFormat.Crop.ShapeWidth = 300 'localização e nome do ficheiro de imagem fJPG = ThisWorkbook.Path & _ "\imagem_" & Format(Now, "ddmmyyyy_hhmmss") & ".jpg" 'exportar grafico tmpChart.Export Filename:=fJPG, FilterName:="jpg" 'eliminar a folha temporaria sem avisos Application.DisplayAlerts = False tmpSheet.Delete Application.DisplayAlerts = True 'repor o estado normal Application.ScreenUpdating = True 'aviso de operação terminada MsgBox "Imagem exportada para o ficheiro:" & fJPG, _ vbInformation, _ "Exportar para JPG" GoTo Fim

Bom dia! o código abaixo gera um print do formulário como um todo, gostaria de limitar o recorte a informação dentro do Frame Private Sub Bt_Print_Click() Dim tmpSheet As Worksheet Dim tmpChart As ChartPasta1.rar Dim tmpImg As Object Dim fJPG As String Dim margem As Integer On Error GoTo erro Application.DisplayAlerts = False Application.ScreenUpdating = False DoEvents keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0 keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0 keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0 keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0 DoEvents 'impede que se veja a acção acelerando o procedimento de cópia 'e exportação Application.ScreenUpdating = False 'uma folha para colocarmos o grafico sem atrapalhar o resto Set tmpSheet = Worksheets.Add 'colocar um grafico nesta nova folha Charts.Add 'definições essenciais ao grafico, para que fique numa worksheet 'e não numa folha grafico ActiveChart.Location Where:=xlLocationAsObject, Name:=tmpSheet.Name Application.Wait Now + TimeValue("00:00:01") Set tmpChart = ActiveChart With tmpChart .Paste Set tmpImg = Selection With .ChartArea '---------> '(não essencial ao funcionamento da rotina) 'coloca um degrade no fundo do grafico .Fill.OneColorGradient _ Style:=msoGradientHorizontal, _ Variant:=1, _ Degree:=0.231372549019608 '<---------- 'sem linha de rebordo .Border.LineStyle = xlNone End With 'configurar a area do grafico acrescentando 'uma pequena borda ao redor da imagem centrando esta margem = 2000 With .Parent .Height = tmpImg.Height + margem .Width = tmpImg.Width + margem End With End With 'localização e nome do ficheiro de imagem fJPG = ThisWorkbook.Path & _ "\imagem_" & Format(Now, "ddmmyyyy_hhmmss") & ".jpg" 'exportar grafico tmpChart.Export Filename:=fJPG, FilterName:="jpg" 'eliminar a folha temporaria sem avisos Application.DisplayAlerts = False tmpSheet.Delete Application.DisplayAlerts = True 'repor o estado normal Application.ScreenUpdating = True 'aviso de operação terminada MsgBox "Imagem exportada para o ficheiro:" & fJPG, _ vbInformation, _ "Exportar para JPG" GoTo Fim erro: MsgBox "Erro: " & Err.Description, _ vbCritical, _ "Erro: " & Err.Number Fim: Set tmpSheet = Nothing Set tmpChart = Nothing Set tmpImg = Nothing 'Unload Me End Sub

@Midori Funcionou perfeitamente, agradeço muito

exemplo.rar Bom dia! preciso fazer com que a imagem de fundo de uma frame mude conforme o valor presente em txt_licenciadora coloquei os arquivos na mesma pagina, os nomes estão corretos, porém a imagem não é carregada. Agradeço qualquer ajuda. Dim Img As String Dim jpg As String Dim Caminho As String Caminho = ThisWorkbook.Path & Application.PathSeparator Img = Me.txt_licenciadora.Value 'Considerando que a textbox vai receber um valor que será o mesmo nome da imagem... On Error GoTo Fim Me.Frame.Picture = LoadPicture(Caminho & Img & jpg) Fim: Exit Sub

@Midori Tentei desta forma, porém não consegui que ele reconhece-se as duas abas. funciona perfeitamente se eu estiver trabalhando só com uma variável, com duas não consegui, alguma dica?

Bom dia! eu tenho o código abaixo para realizar a função de PROCV na aba "Historia" no entanto da forma que fiz o código não reconhece o intervalo onde deveria estar as variáveis "GIBIS ou LIVROS, como posso fazer para selecionar o intervalo de "G" que tenha informação e que reconheça o valor em cada célula? exemplo; G2 = GIBIS, G3= LIVROS, G4 GIBIS etc.

@Midori porque no arquivo final eu tenho outras duas abas referentes as vendas de Revistas e Livros que jogam os dados para Histórico. quanto ao meu problema eu percebi que posso contornar ao gerar identificações diferentes para os numerais repetidos, por exemplo se eu tiver um código de produto 1 em revistas, e 1 em livros, ao ir para o relatório ele deveria ficar como 1 e 1A. como eu posso fazer com que o código identifique a repetição e inclua esse diferencial?

@Midori como posso contornar isso?

Boa tarde! o VBA em anexo utiliza a macro F_relatorio1 para gerar um relatório na aba "Relatório, as colunas F,G e I estão puxando a informação corretamente, porém a descrição dos produtos estão repetindo os da venda 1 para venda 2, PODERIAM ME AJUDARRELATORIO.rar adicionado 1 minuto depois @osvaldomp@Basole

@Osvaldomp, perfeito man, muitíssimo obrigado

@osvaldompO código que você me sugeriu funciona, porém somente no primeiro cadastro, quando tento cadastrar mais um usuário ele substitui a linha 1 e 5, alguma ideia do que pode ser?

Agradeço muito man, deu certo sem utilizar a variável adicionado 15 minutos depois @osvaldompAproveitando a ajuda amigo, o código que você me passou ficou da forma abaixo. isso para 2 Textbox e 5 Checkbox, minha dúvida é como eu poderia fazer que ao selecionar as 5 Checkbox o código repetisse o conteúdo das txtNome (Coluna A) e do txtSenha(Coluna B) e inclui-se a sequencia dos Checkbox? With Worksheets("Senha") .Cells(totalregistro, 1) = txtNome .Cells(totalregistro, 2) = txtSenha If CheckBox1.Value = True Then .Cells(totalregistro, 3) = "Senha" End If If CheckBox2.Value = True Then .Cells(totalregistro, 3) = "Gibis" End If If CheckBox3.Value = True Then .Cells(totalregistro, 3) = "Livros" End If If CheckBox4.Value = True Then .Cells(totalregistro, 3) = "Relatorio" End If If CheckBox5.Value = True Then .Cells(totalregistro, 3) = "Historia" End If End With

Agradeço a Dica @osvaldomp porém ao incluir o meu form, ele envia as informações do usuário e da senha, mas não dos checkbox, pode me dizer o que fiz de errado 'Aqui está o botão responsável por salvar os dados na Planilha de Login lembram da mesma no topico anterior? Private Sub Salvar_Click() 'Tomada de Decisão Sim e Não Dim Resposta As String Resposta = MsgBox("Deseja Salvar Este Usuário Agora?", vbYesNo, "Novo usuário") If Resposta = vbYes Then 'Nossa pasta renomeada no post anterior e onde gravaremos os novos usuários e senhas totalregistro = Worksheets("Senha").UsedRange.Rows.Count + 1 'Campo Obrigatório If txtNome.Text = "" Then MsgBox "Necessito De Um Nome Para Continuar. " txtNome.SetFocus Exit Sub End If Dim NomePlan As String With Worksheets("Senha") .Cells(totalregistro, 1) = txtNome .Cells(totalregistro, 2) = txtSenha If CheckBox1.Value = xlOn Then .Cells(totalregistro, 3) = NomePlan = "Plan1" End If End With 'Mensagem apos a gravação de dados MsgBox ("Gravado Com Sucesso"), vbInformation, ("Novo usuário") txtNome = "" txtSenha = "" 'txtAcesso = "" txtNome.SetFocus End If 'Resposta Não aqui If Reposta = vbNo Then 'Mensagem caso sua resposta seja não MsgBox ("Seus Dados Não Foram Gravados"), vbInformation, ("Novo usuário") txtNome = "" txtSenha = "" ' txtAcesso = "" txtNome.SetFocus End If 'Unload Me 'ActiveWorkbook.Close True 'Application.Quit End Sub

Pasta1.rar Bom dia! no exemplo em anexo eu tenho um formulário de cadastro de usuário, que salva o nome e senha na aba "Senha", e 5 checkbox que se referem as abas que o usuário quer ter acesso, porém ao salvar o Checkbox salva o valor "VERDADEIRO", como eu altero isso para uma String como Senha, Plan1,Plan2, etc.

@[email protected]

Bom dia! estou tentando em um formulário com TextBox e Listview exibir uma imagem no Image1 até o momento consegui que o formulario descubra a imagem com o mesmo nome do txt_titulo e coloque o caminho na planilha, no entanto não exibe a imagem no quadro Private Sub txt_titulo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If txt_titulo <> "" Then If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then retornaProduto CStr(txt_titulo) End If End If End Sub Function retornaProduto(ByVal vCodigo As String) 'Desabilitamos a atualização de tela Application.ScreenUpdating = False 'Selecionamos a Planilha que contém a base de dados With ThisWorkbook.Sheets("Gibis") .Activate 'Seleciona a Coluna onde os ID's estão cadastrados Columns(2).Select 'Se houver erro, vá para o tratamento On Error GoTo ND 'Pesquisamos pelo código informado Selection.Find(vCodigo, ActiveCell, xlValues, xlWhole, xlByRows, xlNext).Activate 'Gravamos ou atualizamos o caminho completo da Imagem na coluna D Cells(ActiveCell.Row, "K") = CStr(ThisWorkbook.Path & "\Imagens\" & vCodigo & ".jpg") 'Seleciona a célula onde o produto foi localizado Cells(ActiveCell.Row, "B").Select 'Preenchemos os campos do UserForm With BUSCA .txt_ID = Cells(ActiveCell.Row, "A") .txt_titulo = vCodigo .txt_numero = Cells(ActiveCell.Row, "C") .txt_ano = Cells(ActiveCell.Row, "D") .txt_licenciadora = Cells(ActiveCell.Row, "E") .txt_editora = Cells(ActiveCell.Row, "F") .txt_estado = Cells(ActiveCell.Row, "G") .txt_quantidade = Cells(ActiveCell.Row, "J") .Image1.PictureSizeMode = fmPictureSizeModeStretch .Image1.Picture = LoadPicture(Cells(ActiveCell.Row, "K")) End With ND: If Err = 91 Then 'Se o erro for 91 (não encontrado), informamos sobre o erro MsgBox "O produto " & vCodigo & " não existe ou não foi cadastrado!", vbCritical, "Erro" 'E limpamos o formulário BUSCA.txt_ID = "" BUSCA.txt_titulo = "" BUSCA.txt_numero = "" BUSCA.txt_ano = "" BUSCA.txt_licenciadora = "" BUSCA.txt_editora = "" BUSCA.txt_estado = "" BUSCA.txt_quantidade = "" BUSCA.Image1.Picture = Nothing End If End With 'Habilitamos a atualização de tela Application.ScreenUpdating = True End Function adicionado 49 minutos depois Exemplificando: ao digitar o nome 100 BALAS no textbox Titulo, o caminho para o arquivo jpg aparece na celula K, porém não aparece a imagem no Image ao lado. PROJETO VÉSPER V8.rar

Bom dia! analisando melhor verifiquei que o erro está no Userform_initialize, alguma dica parta corrigir? Private Sub UserForm_Initialize() With ListView1 '.BorderStyle = ccFixedSingle .Gridlines = True .View = lvwReport .FullRowSelect = True .MultiSelect = True .ColumnHeaders.Add Text:="ID:", Width:=1 'COLUNA ENDEREÇO DA IDENTIFICAÇÃO .ColumnHeaders.Add Text:="TÍTULO:", Width:=220 'COLUNA ENDEREÇO DA TITULO .ColumnHeaders.Add Text:="NÚMERO:", Width:=58, Alignment:=0 'COLUNA ENDEREÇO DA NUMERAÇÃO .ColumnHeaders.Add Text:="ANO:", Width:=40, Alignment:=2 'COLUNA ENDEREÇO DO ANO .ColumnHeaders.Add Text:="LICENCIADORA:", Width:=140, Alignment:=0 'COLUNA ENDEREÇO DA LICENCIADORA .ColumnHeaders.Add Text:="EDITORA:", Width:=120, Alignment:=0 'COLUNA ENDEREÇO DA editora .ColumnHeaders.Add Text:="QUANT:", Width:=70, Alignment:=0 'COLUNA ENDEREÇO DA estado '.ColumnHeaders.Add Text:="Imagem:", Width:=1, Alignment:=2 'COLUNA ENDEREÇO DA IMAGEM (OCULTA) End With ListView1.ListItems.Clear Sheets("Gibis").Select lin = 2 Do Until Sheets("Gibis").Cells(lin, 1) = "" Set li = ListView1.ListItems.Add(Text:=Sheets("Gibis").Cells(lin, 1).Value) li.ListSubItems.Add Text:=Sheets("Gibis").Cells(lin, 2).Value li.ListSubItems.Add Text:=Sheets("Gibis").Cells(lin, 3).Value li.ListSubItems.Add Text:=Sheets("Gibis").Cells(lin, 4).Value li.ListSubItems.Add Text:=Sheets("Gibis").Cells(lin, 5).Value li.ListSubItems.Add Text:=Sheets("Gibis").Cells(lin, 6).Value li.ListSubItems.Add Text:=Sheets("Gibis").Cells(lin, 7).Value li.ListSubItems.Add Text:=Sheets("Gibis").Cells(lin, 8).Value lin = lin + 1 Loop With ListView2 '.BorderStyle = ccFixedSingle '.Gridlines = True '.View = lvwReport '.FullRowSelect = True '.MultiSelect = True .ColumnHeaders.Add Text:="ID:", Width:=1 'COLUNA ENDEREÇO DA IDENTIFICAÇÃO .ColumnHeaders.Add Text:="TÍTULO:", Width:=221 'COLUNA ENDEREÇO DA TITULO .ColumnHeaders.Add Text:="AUTOR:", Width:=201, Alignment:=0 'COLUNA ENDEREÇO DO AUTOR .ColumnHeaders.Add Text:="ANO:", Width:=35, Alignment:=0 'COLUNA ENDEREÇO DO ANO .ColumnHeaders.Add Text:="EDITORA:", Width:=188, Alignment:=0 'COLUNA ENDEREÇO DA EDITORA End With ListView2.ListItems.Clear Sheets("Livros").Select lin = 2 Do Until Sheets("Livros").Cells(lin, 1) = "" Set li = ListView2.ListItems.Add(Text:=Sheets("Livros").Cells(lin, 1).Value) li.ListSubItems.Add Text:=Sheets("Livros").Cells(lin, 2).Value li.ListSubItems.Add Text:=Sheets("Livros").Cells(lin, 3).Value li.ListSubItems.Add Text:=Sheets("Livros").Cells(lin, 4).Value li.ListSubItems.Add Text:=Sheets("Livros").Cells(lin, 5).Value lin = lin + 1 Loop MultiPage1.Style = 1 MultiPage1.ForeColor = RGB(28, 28, 28) MultiPage1.BackColor = RGB(0, 0, 0) End Sub

Boa tarde senhores! Eu tenho o arquivo em anexo, onde o private sub Pesquisa_Click deve pesquisar o texto digitado nas textbox ao se dar dois cliques, tanto na pagina "Gibis" quanto na "Livros" a pagina Livros está pesquisando normalmente pela sub Pesquisalivros, porém a pagina Gibis quando realizada uma primeira pesquisa não retorna a pesquisa, só funcionando após realizar uma limpeza das textbox. já verifiquei o código e não encontrei o erro, agradeço qualquer ajuda.

@olliver.soul Valeu man, era isso mesmo, após alterar os outros eventos ficou correto.

@olliver.soul Obrigado pela dica oliver, porém ao fazer a alteração proposta exibe a imagem, mais ele entende que estou procurando na coluna de "Editora"