Ana.Paula

Não consigo enviar por aqui, você pode me passar seu e-mail para enviar?

Olá galera tenho uma programação com um calendário em formato americano mês/dia/ano, preciso modificá-lo para o brasileiro dia/mês/ano, alguém pode me ajudar? Private diaSemana As Integer Private PrimeiroDiaMes As Date Private UltimoDiaMes As Date Private DiasCalendario As Date Private iMes, iAno As Integer Private Botoes(1 To 6, 1 To 7) As Object Private aCalendario(1 To 6, 1 To 7) As Date Private Sub UserForm_Activate() iMes = Month(Now) iAno = Year(Now) PrimeiroDiaMes = "01/" & iMes & "/" & iAno End Sub Private Sub UserForm_Initialize() Set Botoes(1, 1) = CommandButton1 Set Botoes(1, 2) = CommandButton2 Set Botoes(1, 3) = CommandButton3 Set Botoes(1, 4) = CommandButton4 Set Botoes(1, 5) = CommandButton5 Set Botoes(1, 6) = CommandButton6 Set Botoes(1, 7) = CommandButton7 Set Botoes(2, 1) = CommandButton8 Set Botoes(2, 2) = CommandButton9 Set Botoes(2, 3) = CommandButton10 Set Botoes(2, 4) = CommandButton11 Set Botoes(2, 5) = CommandButton12 Set Botoes(2, 6) = CommandButton13 Set Botoes(2, 7) = CommandButton14 Set Botoes(3, 1) = CommandButton15 Set Botoes(3, 2) = CommandButton16 Set Botoes(3, 3) = CommandButton17 Set Botoes(3, 4) = CommandButton18 Set Botoes(3, 5) = CommandButton19 Set Botoes(3, 6) = CommandButton20 Set Botoes(3, 7) = CommandButton21 Set Botoes(4, 1) = CommandButton22 Set Botoes(4, 2) = CommandButton23 Set Botoes(4, 3) = CommandButton24 Set Botoes(4, 4) = CommandButton25 Set Botoes(4, 5) = CommandButton26 Set Botoes(4, 6) = CommandButton27 Set Botoes(4, 7) = CommandButton28 Set Botoes(5, 1) = CommandButton29 Set Botoes(5, 2) = CommandButton30 Set Botoes(5, 3) = CommandButton31 Set Botoes(5, 4) = CommandButton32 Set Botoes(5, 5) = CommandButton33 Set Botoes(5, 6) = CommandButton34 Set Botoes(5, 7) = CommandButton35 Set Botoes(6, 1) = CommandButton36 Set Botoes(6, 2) = CommandButton37 Set Botoes(6, 3) = CommandButton38 Set Botoes(6, 4) = CommandButton39 Set Botoes(6, 5) = CommandButton40 Set Botoes(6, 6) = CommandButton41 Set Botoes(6, 7) = CommandButton42 iMes = Month(Now) iAno = Year(Now) PrimeiroDiaMes = "01/" & iMes & "/" & iAno fAtualiza For i = 1 To 6 For J = 1 To 7 Botoes(i, J).Caption = Day(aCalendario(i, J)) If Weekday(aCalendario(i, J)) = 1 Or Weekday(aCalendario(i, J)) = 7 Then Botoes(i, J).BackColor = &HC0C0FF End If If aCalendario(i, J) = Format(Now, "dd/mm/yy") Then Botoes(i, J).BackColor = vbCyan End If Next Next Label9.Caption = "Hoje: " & Format(Now, "dd/mm/yy") End Sub Private Sub btmVolta_Click() iMes = iMes - 1 If iMes = 0 Then iMes = 12 iAno = iAno - 1 End If PrimeiroDiaMes = "01/" & iMes & "/" & iAno fAtualiza End Sub Private Sub btmAvanca_Click() iMes = iMes + 1 If iMes = 13 Then iMes = 1 iAno = iAno + 1 End If PrimeiroDiaMes = "01/" & iMes & "/" & iAno fAtualiza End Sub Function fAtualiza() UltimoDiaMes = "01/" & iMes + 1 & "/" & iAno UltimoDiaMes = UltimoDiaMes - 1 diaSemana = Weekday(PrimeiroDiaMes) If Day(UltimoDiaMes) = 31 And diaSemana = 7 Then frmCalendario.Height = 308 Label9.Top = 258 For ii = 1 To 7 Botoes(6, ii).Visible = True Next Else frmCalendario.Height = 276 Label9.Top = 228 For ii = 1 To 7 Botoes(6, ii).Visible = False Next End If PrimeiroDiaCalendario = PrimeiroDiaMes - diaSemana + 1 DiasCalendario = PrimeiroDiaCalendario Label8.Caption = MonthName(iMes) & " de " & iAno For i = 1 To 6 For J = 1 To 7 aCalendario(i, J) = DiasCalendario DiasCalendario = DiasCalendario + 1 Next Next For i = 1 To 6 For J = 1 To 7 Botoes(i, J).Caption = Day(aCalendario(i, J)) Next Next End Function Private Sub CommandButton1_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton2_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton3_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton4_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton5_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton6_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton7_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton8_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton9_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton10_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton11_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton12_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton13_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton14_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton15_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton16_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton17_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton18_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton19_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton20_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton21_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton22_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton23_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton24_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton25_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton26_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton27_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton28_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton29_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton30_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton31_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton32_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton33_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton34_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton35_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton36_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton37_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton38_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton39_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton40_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton41_Click() RetornaData Me.ActiveControl End Sub Private Sub CommandButton42_Click() RetornaData Me.ActiveControl End Sub Function RetornaData(Obj As Object) For i = 1 To 6 For J = 1 To 7 If Botoes(i, J).Name = Obj.Name Then Obj_frm.Value = aCalendario(i, J) frmCalendario.Hide End If Next Next End Function

Alyson Ronnan Martins era isso mesmo muito obrigada, eu sabia que era bem simples mais eu não conseguia fazer, fiz o mesmo comando mais me esqueci da function, isso vai ser muito importante para conseguir um trabalho que estou estagiando e desenvolvendo o programa como melhoria, pude perceber esse problema e só um software simples solucionava, sou entusiasta do VBA nunca estudei programação, já fiz alguns programas até mais complexos mais nunca com imagem e comecei a tentar, agradeço muito a você e se tudo der certo saiba que sua ajuda foi parte de ter conseguido...outra ver muito obrigada, abraço

Alyson Ronnan Martins, o programa está salvando o caminho da imagem na planilha, preciso que a pesquisa puxe o caminho salvo na Planilha PCP, coluna T iniciando da linha 2, e retorne a imagem que foi salva. Vou enviar o codigo da Sub Pesquisar, mas não tenho nada nela ainda....Exemplo: Tenho o botão Novo, Gravar e Pesquisar. Quando clico em Novo insiro dados e uma imagem de um produto isso está tudo ok, em Gravar, gravo os dados que inseri e a imagem esta ok também. Porem quando clico no código do produto que inseri anteriormente e em pesquisar, somente a imagem não vem, os dados estão normais, eles aparecem. A Sub buttonpesq tem que chamar a imagem que teve o caminho salvo na planilha. Private Sub buttonpesq_Click() Dim iLin As Long iLin = cmbcodigo.ListIndex + 2 If iLin > 1 Then fDados_PCP iLin 'habilitar botãoeditar buttoneditar.Enabled = True buttonexcluir.Enabled = True buttonnovo.Enabled = True buttongravar.Enabled = True cmbdescricao.Value = "" End If End Sub

Muito Obrigada Alyson Ronnan Martins, mas ele está salvando tudo certo nessa parte, ele puxa a imagem no sistema salva na planilha, o problema é que eu gostaria de um comando para puxar as imagens que foram salvas na planilha quando clicasse em pesquisar, elas não voltam, tentei vários mais nada funcionou. Então quando pesquiso um código a imagem que salvei não aparece.

Olá pessoal alguém pode me ajudar, estou fazendo um programa no VBA, e não consigo colocar uma programação para puxar a imagem que salvei na planilha do Excel, coloco Novo digito o código do produto, os dados, insiro a foto e ok salva, porém quando pesquiso o código do produto que acabei de salvar, não consigo uma programação para puxar a imagem junto com os dados salvos, fazendo-a aparecer em pesquisa e quando eu edito um registro que salvei, alguém pode me ajudar? Dim Selecao As String Public beditar As Boolean Private Sub bloqpesq_Click() End Sub Private Sub botpesq2_Click() Dim iLin As Long iLin = cmbdescricao.ListIndex + 2 If iLin > 1 Then fDados_PCP iLin 'habilitar botãoeditar buttoneditar.Enabled = True buttonexcluir.Enabled = True buttonnovo.Enabled = True End If buttonexcluir.Enabled = False buttoneditar.Enabled = False buttonnovo.Enabled = False End Sub Private Sub buttongravar_Click() Dim iLin As Long If beditar = True Then 'Quando estou editando um registro iLin = cmbcodigo.ListIndex + 2 Else If fProcura_Cod(txtboxcodigoprod.Value) = True Then MsgBox ("Código já cadastrado!") Exit Sub End If iLin = Range("A1048500").End(xlUp).Row + 1 If IsNumeric(Cells(iLin - 1, "A").Value) Then Cells(iLin, "A").Value = Cells(iLin - 1, "A").Value + 1 ' codigo Else Cells(iLin, "A").Value = 1 End If End If If (txtboxcodigoprod.Text = "") Then MsgBox ("Digitar um Código Valido!") Exit Sub Else Cells(iLin, "B").Value = txtboxcodigoprod.Text End If If txtboxdescricao.Text = "" Then MsgBox ("Digite a Descrição!") Exit Sub Else Cells(iLin, "C").Value = txtboxdescricao.Text End If If txtboxex1.Text = "" Then MsgBox ("Digite o Item 1!") Exit Sub Else Cells(iLin, "D").Value = txtboxex1.Text End If If txtboxex2.Text = "" Then MsgBox ("Digite o Item 2!") Exit Sub Else Cells(iLin, "E").Value = txtboxex2.Text End If ' Para esses items se quiser que sejam obrigatórios repetir o mesmo procedimento! Cells(iLin, "E").Value = txtboxex2.Text Cells(iLin, "F").Value = txtboxex3.Text Cells(iLin, "G").Value = txtboxex4.Text Cells(iLin, "H").Value = txtboxex5.Text Cells(iLin, "I").Value = txtboxex6.Text Cells(iLin, "J").Value = txtboxex7.Text Cells(iLin, "K").Value = txtboxex8.Text Cells(iLin, "L").Value = txtboxex9.Text Cells(iLin, "M").Value = txtboxex10.Text Cells(iLin, "N").Value = txtboxvari1.Text Cells(iLin, "O").Value = txtboxvari2.Text Cells(iLin, "P").Value = txtboxvari3.Text Cells(iLin, "Q").Value = txtboxvari4.Text Cells(iLin, "R").Value = txtboxvari5.Text Cells(iLin, "S").Value = txtboxvari6.Text Cells(iLin, "T").Value = Selecao Flimpadados MsgBox "Código gravado com sucesso!" End Sub Function fProcura_Cod(sCodigo As String) As Boolean Dim bFind As Boolean bFind = False With Worksheets("PCP").Range("B1:B60000") Set c = .Find(sCodigo, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) If Not c Is Nothing Then firstAddress = c.Address Do If c.Value = sCodigo Then bFind = True fProcura_Cod = bFind Exit Function End If Set c = .FindNext(c) Loop While Not c Is Nothing End If End With End Function Private Sub buttonexcluir_Click() Dim iLin As Long iLin = cmbcodigo.ListIndex + 2 If iLin > 1 Then If MsgBox("Deseja realmente excluir o produto?", vbYesNo) = vbYes Then Range("A" & iLin).EntireRow.Delete End If End If Flimpadados cmbdescricao.Enabled = False botpesq2.Enabled = False End Sub Private Sub buttoneditar_Click() buttonnovo.Enabled = False Frame1.Enabled = True Frame1.BackColor = vbCyan beditar = True Frame1.BackColor = vbCyan Label1.BackColor = vbCyan Label2.BackColor = vbCyan Label3.BackColor = vbCyan Label4.BackColor = vbCyan Label5.BackColor = vbCyan Label6.BackColor = vbCyan Label7.BackColor = vbCyan Label8.BackColor = vbCyan Label9.BackColor = vbCyan Label10.BackColor = vbCyan Label11.BackColor = vbCyan Label12.BackColor = vbCyan Label13.BackColor = vbCyan Label14.BackColor = vbCyan Label15.BackColor = vbCyan Label16.BackColor = vbCyan Label17.BackColor = vbCyan Label18.BackColor = vbCyan Label19.BackColor = vbCyan Label20.BackColor = vbCyan Label23.BackColor = vbCyan End Sub Private Sub buttonlimpar_Click() buttoneditar.Enabled = True buttonnovo.Enabled = True beditar = False buttongravar.Enabled = False cmbcodigo.Value = "" txtposicao.Value = "" txtboxcodigoprod.Value = "" txtboxdescricao.Value = "" txtboxex1.Value = "" txtboxex2.Value = "" txtboxex3.Value = "" txtboxex4.Value = "" txtboxex5.Value = "" txtboxex6.Value = "" txtboxex7.Value = "" txtboxex8.Value = "" txtboxex9.Value = "" txtboxex10.Value = "" txtboxvari1.Value = "" txtboxvari2.Value = "" txtboxvari3.Value = "" txtboxvari4.Value = "" txtboxvari5.Value = "" txtboxvari6.Value = "" cmbdescricao.Value = "" frmPrincipal.Image1.Picture = LoadPicture() Frame1.BackColor = -2147483633 Label1.BackColor = -2147483633 Label2.BackColor = -2147483633 Label3.BackColor = -2147483633 Label4.BackColor = -2147483633 Label5.BackColor = -2147483633 Label6.BackColor = -2147483633 Label7.BackColor = -2147483633 Label8.BackColor = -2147483633 Label9.BackColor = -2147483633 Label10.BackColor = -2147483633 Label11.BackColor = -2147483633 Label12.BackColor = -2147483633 Label13.BackColor = -2147483633 Label14.BackColor = -2147483633 Label15.BackColor = -2147483633 Label16.BackColor = -2147483633 Label17.BackColor = -2147483633 Label18.BackColor = -2147483633 Label19.BackColor = -2147483633 Label20.BackColor = -2147483633 Label23.BackColor = -2147483633 beditar = False End Sub Private Sub buttonnovo_Click() Frame1.Enabled = True frmPrincipal.cmdimagem.Enabled = True buttongravar.Enabled = True Frame1.BackColor = vbWhite Label1.BackColor = vbWhite Label2.BackColor = vbWhite Label3.BackColor = vbWhite Label4.BackColor = vbWhite Label5.BackColor = vbWhite Label6.BackColor = vbWhite Label7.BackColor = vbWhite Label8.BackColor = vbWhite Label9.BackColor = vbWhite Label10.BackColor = vbWhite Label11.BackColor = vbWhite Label12.BackColor = vbWhite Label13.BackColor = vbWhite Label14.BackColor = vbWhite Label15.BackColor = vbWhite Label16.BackColor = vbWhite Label17.BackColor = vbWhite Label18.BackColor = vbWhite Label19.BackColor = vbWhite Label20.BackColor = vbWhite Label23.BackColor = vbWhite buttonnovo.SetFocus beditar = False cmbcodigo.Value = "" frmPrincipal.cmdimagem.Enabled = True End Sub Private Sub buttonpesq_Click() Dim iLin As Long iLin = cmbcodigo.ListIndex + 2 If iLin > 1 Then fDados_PCP iLin 'habilitar botãoeditar buttoneditar.Enabled = True buttonexcluir.Enabled = True buttonnovo.Enabled = True buttongravar.Enabled = True cmbdescricao.Value = "" End If End Sub Private Sub CheckBox1_Click() If CheckBox1.Value = True Then cmbdescricao.Enabled = True If CheckBox1.Value = False Then cmbdescricao.Enabled = False If CheckBox1.Value = True Then botpesq2.Enabled = True If CheckBox1.Value = False Then botpesq2.Enabled = False If CheckBox1.Value = True Then cmbcodigo.Enabled = False If CheckBox1.Value = True Then buttonpesq.Enabled = False If CheckBox1.Value = False Then cmbcodigo.Enabled = True If CheckBox1.Value = False Then buttonpesq.Enabled = True cmbcodigo.Value = "" cmbcodigo.Value = "" txtposicao.Value = "" txtboxcodigoprod.Value = "" txtboxdescricao.Value = "" txtboxex1.Value = "" txtboxex2.Value = "" txtboxex3.Value = "" txtboxex4.Value = "" txtboxex5.Value = "" txtboxex6.Value = "" txtboxex7.Value = "" txtboxex8.Value = "" txtboxex9.Value = "" txtboxex10.Value = "" txtboxvari1.Value = "" txtboxvari2.Value = "" txtboxvari3.Value = "" txtboxvari4.Value = "" txtboxvari5.Value = "" txtboxvari6.Value = "" frmPrincipal.Image1.Picture = LoadPicture() End Sub Private Sub cmbcodigo_Change() cmbdescricao.Value = "" End Sub Private Sub cmbdescricao_Change() buttonexcluir.Enabled = False buttoneditar.Enabled = False buttongravar.Enabled = False buttonnovo.Enabled = False End Sub Private Sub cmdimagem_Click() Dim Figura As Office.FileDialog Set Figura = Application.FileDialog(msoFileDialogFilePicker) With Figura AllowMultiSelect = False Title = "Selecione a imagem." .Filters.Add "imagem JPG", "*.jpg *" If Figura.Show = True Then Selecao = Figura.SelectedItems.Item(1) frmPrincipal.Image1.Picture = LoadPicture(Selecao) End If End With End Sub Private Sub CommandButton7_Click() Application.Visible = False End Sub Private Sub CommandButton8_Click() Application.Visible = True End Sub Private Sub SubabreUserForm1() UserForm1.Show End Sub Private Sub Frame1_Click() End Sub Private Sub UserForm_Initialize() buttongravar.Enabled = False cmbcodigo.SetFocus Application.Visible = False fCarrega_Cmbcodigo fCarrega_Cmbdescricao End Sub Function Flimpadados() txtposicao.Value = "" txtboxcodigoprod.Value = "" txtboxdescricao.Value = "" txtboxex1.Value = "" txtboxex2.Value = "" txtboxex3.Value = "" txtboxex4.Value = "" txtboxex5.Value = "" txtboxex6.Value = "" txtboxex7.Value = "" txtboxex8.Value = "" txtboxex9.Value = "" txtboxex10.Value = "" txtboxvari1.Value = "" txtboxvari2.Value = "" txtboxvari3.Value = "" txtboxvari4.Value = "" txtboxvari5.Value = "" txtboxvari6.Value = "" frmPrincipal.Image1.Picture = LoadPicture() fCarrega_Cmbcodigo fCarrega_Cmbdescricao Frame1.BackColor = -2147483633 Frame1.BackColor = -2147483633 Label1.BackColor = -2147483633 Label2.BackColor = -2147483633 Label3.BackColor = -2147483633 Label4.BackColor = -2147483633 Label5.BackColor = -2147483633 Label6.BackColor = -2147483633 Label7.BackColor = -2147483633 Label8.BackColor = -2147483633 Label9.BackColor = -2147483633 Label10.BackColor = -2147483633 Label11.BackColor = -2147483633 Label12.BackColor = -2147483633 Label13.BackColor = -2147483633 Label14.BackColor = -2147483633 Label15.BackColor = -2147483633 Label16.BackColor = -2147483633 Label17.BackColor = -2147483633 Label18.BackColor = -2147483633 Label19.BackColor = -2147483633 Label20.BackColor = -2147483633 Label23.BackColor = -2147483633 Frame1.Enabled = False buttoneditar.Enabled = False buttonexcluir.Enabled = False End Function Function fCarrega_Cmbcodigo() Dim iLin As Long iLin = 2 'limpa combobox cmbcodigo.Clear 'carrega cmbcodigo While Cells(iLin, "A").Text <> "" cmbcodigo.AddItem Cells(iLin, "B").Text iLin = iLin + 1 Wend End Function Function fDados_PCP(iLinha As Long) 'Carrega dados txtposicao.Value = Cells(iLinha, "A").Text txtboxcodigoprod.Value = Cells(iLinha, "B").Text txtboxdescricao.Value = Cells(iLinha, "C").Text txtboxex1.Value = Cells(iLinha, "D").Text txtboxex2.Value = Cells(iLinha, "E").Text txtboxex3.Value = Cells(iLinha, "F").Text txtboxex4.Value = Cells(iLinha, "G").Text txtboxex5.Value = Cells(iLinha, "H").Text txtboxex6.Value = Cells(iLinha, "I").Text txtboxex7.Value = Cells(iLinha, "J").Text txtboxex8.Value = Cells(iLinha, "K").Text txtboxex9.Value = Cells(iLinha, "L").Text txtboxex10.Value = Cells(iLinha, "M").Text txtboxvari1.Value = Cells(iLinha, "N").Text txtboxvari2.Value = Cells(iLinha, "O").Text txtboxvari3.Value = Cells(iLinha, "P").Text txtboxvari4.Value = Cells(iLinha, "Q").Text txtboxvari5.Value = Cells(iLinha, "R").Text txtboxvari6.Value = Cells(iLinha, "S").Text End Function Function fCarrega_Cmbdescricao() Dim iLin As Long iLin = 2 'limpa combobox cmbdescricao.Clear 'carrega cmbcodigo While Cells(iLin, "A").Text <> "" cmbdescricao.AddItem Cells(iLin, "C").Text iLin = iLin + 1 Wend End Function