Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Valider l'enregistrement d'une image dans un userform

linkon0007

XLDnaute Nouveau
Bonjour,

J'ai réussi à créer un formulaire à 'aide d'un exemple pour ajouter, supprimer ou modifier les données.

Le seul blocage est le suivant : j'arrive à valider l'enregistrement d'une photo, mais par contre, je n'arrive pas à la visualiser au niveau du userform.



je vous donne le code que j'ai mis :

Option Explicit

Const colCodePatient As Integer = 1
Const colNompatient As Integer = 2
Const colPhoto As Integer = 3
Const colTéléphone As Integer = 4
Const colAge As Integer = 5
Const colDatedenaissance As Integer = 6
Const colAntécédentsgénéraux As Integer = 7
Const colASSURANCEMALADIE As Integer = 8
Const colVille As Integer = 9
Const indiceMinimo As Byte = 2
Const corDisabledTextBox As Long = -2147483633
Const corEnabledTextBox As Long = -2147483643

Private wsCadastro As Worksheet
Private indiceRegistro As Long
Dim Photo
Private Sub cmdannuler_Click()
cmdvalider.Enabled = False
cmdannuler.Enabled = False
Call DesabilitaControles
Call CarregaDadosInicial
Call HabilitaBotoesAlteracao
End Sub
Private Sub Cmdchemin_Click()
Photo = Application.GetOpenFilename("Fichiers gif ou jpg,*.gif;*.jpg")
If Photo = False Then Exit Sub 'pour le cas ou l'utilisateur clique sur annuler
'dans la boite d'ouverture de fichier
Imagephoto.Picture = LoadPicture(Photo)
Imagephoto.Visible = True
Cmdchemin.Visible = False
End Sub

Private Sub Cmdsupprimer_Click()
With Imagephoto
Imagephoto.Picture = Nothing
End With
Cmdchemin.Visible = True
End Sub

Private Sub cmdvalider_Click()
Dim proximoId As Long

'Altera
If optmodifier.Value Then
Call SalvaRegistro(CLng(txtcode.Text), indiceRegistro)
lblMensagem.Caption = "Votre Enrgistrement est validé"
End If
'Novo
If optajouter.Value Then
proximoId = PegaProximoId
'pega a próxima linha
Dim proximoIndice As Long
proximoIndice = wsCadastro.UsedRange.Rows.Count + 1
Call SalvaRegistro(proximoId, proximoIndice)
txtcode = proximoId
lblMensagem.Caption = " Votre Enrgistrement est validé "
End If
'Excluir
If optsupprimer.Value Then
Dim result As VbMsgBoxResult
result = MsgBox("Voulez-vous supprimer la fiche nº " & txtcode.Text & " ?", vbYesNo, "Confirmação")

If result = vbYes Then
wsCadastro.Range(wsCadastro.Cells(indiceRegistro, colCodePatient), wsCadastro.Cells(indiceRegistro, colCodePatient)).EntireRow.Delete
Call CarregaDadosInicial
lblMensagem.Caption = " Votre Enrgistrement est supprimé avec succès "
End If
End If

Call HabilitaBotoesAlteracao
Call DesabilitaControles

End Sub


Private Sub optmodifier_Click()
If txtcode.Text <> vbNullString And txtcode.Text <> "" Then
Call HabilitaControles
Call DesabilitaBotoesAlteracao
'dá o foco ao primeiro controle de dados
txtpatient.SetFocus
Else
lblMensagem.Caption = "Não há registro a ser alterado"
End If
Imagephoto.Visible = True
Cmdchemin.Visible = False
End Sub

Private Sub optsupprimer_Click()
If txtcode.Text <> vbNullString And txtcode.Text <> "" Then
Call DesabilitaBotoesAlteracao
lblMensagem.Caption = "Modo de exclusão. Confira o dados do registro antes de excluí-lo"
Else
lblMensagem.Caption = "Não há registro a ser excluído"
End If
Imagephoto.Visible = True
Cmdchemin.Visible = False
End Sub

Private Sub optajouter_Click()
Call LimpaControles
Call HabilitaControles
Call DesabilitaBotoesAlteracao
'dá o foco ao primeiro controle de dados
txtpatient.SetFocus
Imagephoto.Visible = False
Cmdchemin.Visible = True
End Sub

Private Sub UserForm_Initialize()
Set wsCadastro = ThisWorkbook.Worksheets("Patients")
Call HabilitaBotoesAlteracao
Call CarregaDadosInicial
Call DesabilitaControles
End Sub

Private Sub btnAnterior_Click()
If indiceRegistro > indiceMinimo Then
indiceRegistro = indiceRegistro - 1
End If
If indiceRegistro > 1 Then
Call CarregaRegistro
End If
End Sub

Private Sub btnPrimeiro_Click()
indiceRegistro = indiceMinimo
If indiceRegistro > 1 Then
Call CarregaRegistro
End If
End Sub

Private Sub btnProximo_Click()
If indiceRegistro < wsCadastro.UsedRange.Rows.Count Then
indiceRegistro = indiceRegistro + 1
End If
If indiceRegistro > 1 Then
Call CarregaRegistro
End If
End Sub

Private Sub btnUltimo_Click()
indiceRegistro = wsCadastro.UsedRange.Rows.Count
If indiceRegistro > 1 Then
Call CarregaRegistro
End If
End Sub

Private Sub CarregaDadosInicial()
indiceRegistro = 2
Call CarregaRegistro
End Sub

Private Sub CarregaRegistro()
'carrega os dados do primeiro registro
With wsCadastro
If Not IsEmpty(.Cells(indiceRegistro, colTéléphone)) Then
Me.txtcode.Text = .Cells(indiceRegistro, colCodePatient).Value
Me.txtpatient.Text = .Cells(indiceRegistro, colNompatient).Value
Photo = .Cells(indiceRegistro, colPhoto).Value
Me.txttelephone.Text = .Cells(indiceRegistro, colTéléphone).Value
Me.txtage.Text = .Cells(indiceRegistro, colAge).Value
Me.txtdate.Text = .Cells(indiceRegistro, colDatedenaissance).Value
Me.txtant.Text = .Cells(indiceRegistro, colAntécédentsgénéraux).Value
Me.txtassurance.Text = .Cells(indiceRegistro, colASSURANCEMALADIE).Value
Me.txtville.Text = .Cells(indiceRegistro, colVille).Value

End If
End With

Call AtualizaRegistroCorrente
End Sub

Public Sub CarregaRegistroPorIndice(ByVal indice As Long)
'carrega os dados do registro baseado no índice
indiceRegistro = indice

Call CarregaRegistro
End Sub

Private Sub SalvaRegistro(ByVal id As Long, ByVal indice As Long)
With wsCadastro
.Cells(indice, colCodePatient).Value = id
.Cells(indice, colNompatient).Value = Me.txtpatient.Text
.Cells(indice, colPhoto).Value = Photo
.Cells(indice, colTéléphone).Value = Me.txttelephone.Text
.Cells(indice, colAge).Value = Me.txtage.Text
.Cells(indice, colDatedenaissance).Value = Me.txtdate.Text
.Cells(indice, colAntécédentsgénéraux).Value = Me.txtant.Text
.Cells(indice, colASSURANCEMALADIE).Value = Me.txtassurance.Text
.Cells(indice, colVille).Value = Me.txtville.Text


End With

Call AtualizaRegistroCorrente
End Sub
Private Function PegaProximoId() As Long
Dim rangeIds As Range
'pega o range que se refere a toda a coluna do código (id)
Set rangeIds = wsCadastro.Range(wsCadastro.Cells(indiceMinimo, colCodePatient), wsCadastro.Cells(wsCadastro.UsedRange.Rows.Count, colCodePatient))
PegaProximoId = WorksheetFunction.Max(rangeIds) + 1
End Function

Private Sub AtualizaRegistroCorrente()
lblNavigator.Caption = indiceRegistro - 1 & " de " & wsCadastro.UsedRange.Rows.Count - 1
lblMensagem.Caption = ""
End Sub

Private Sub LimpaControles()
Me.txtcode.Text = ""
Me.txtpatient.Text = ""
Imagephoto.Picture = Nothing
Me.txttelephone.Text = ""
Me.txtage.Text = ""
Me.txtdate.Text = ""
Me.txtant.Text = ""
Me.txtassurance.Text = ""
Me.txtville.Text = ""
End Sub

Private Sub HabilitaControles()
'Me.txtcode.Locked = False
Me.txtpatient.Locked = False
Imagephoto.Visible = False
Me.txttelephone.Locked = False
Me.txtage.Locked = False
Me.txtdate.Locked = False
Me.txtant.Locked = False
Me.txtassurance.Locked = False
Me.txtville.Locked = False


Me.txtpatient.BackColor = corEnabledTextBox
Me.txttelephone.BackColor = corEnabledTextBox
Me.txtage.BackColor = corEnabledTextBox
Me.txtdate.BackColor = corEnabledTextBox
Me.txtant.BackColor = corEnabledTextBox
Me.txtassurance.BackColor = corEnabledTextBox
Me.txtville.BackColor = corEnabledTextBox
End Sub

Private Sub DesabilitaControles()
'Me.txtcode.Locked = True
Me.txtpatient.Locked = True
Imagephoto.Visible = True
Me.txttelephone.Locked = True
Me.txtage.Locked = True
Me.txtdate.Locked = True
Me.txtant.Locked = True
Me.txtassurance.Locked = True
Me.txtville.Locked = True


Me.txtpatient.BackColor = corDisabledTextBox
Me.txttelephone.BackColor = corDisabledTextBox
Me.txtage.BackColor = corDisabledTextBox
Me.txtdate.BackColor = corDisabledTextBox
Me.txtant.BackColor = corDisabledTextBox
Me.txtassurance.BackColor = corDisabledTextBox
Me.txtville.BackColor = corDisabledTextBox
End Sub

Private Sub HabilitaBotoesAlteracao()
'habilita os botões de alteração
optmodifier.Enabled = True
optsupprimer.Enabled = True
optajouter.Enabled = True
cmdliste.Enabled = True
cmdvalider.Enabled = False
cmdannuler.Enabled = False

'limpa os valores dos controles
optmodifier.Value = False
optsupprimer.Value = False
optajouter.Value = False
End Sub

Private Sub DesabilitaBotoesAlteracao()
'desabilita os botões de alteração
optmodifier.Enabled = False
optsupprimer.Enabled = False
optajouter.Enabled = False
cmdliste.Enabled = False
cmdvalider.Enabled = True
cmdannuler.Enabled = True
End Sub

Public Function ProcuraIndiceRegistroPodId(ByVal id As Long) As Long
Dim i As Long
Dim retorno As Long
Dim encontrado As Boolean

i = indiceMinimo
With wsCadastro
Do While Not IsEmpty(.Cells(i, colCodePatient))
If .Cells(i, colCodePatient).Value = id Then
retorno = i
encontrado = True
Exit Do
End If
i = i + 1
Loop
End With

'caso não encontre o registro, retorna -1
If Not encontrado Then
retorno = -1
End If

ProcuraIndiceRegistroPodId = i
End Function
 

Pièces jointes

  • exemple fichier.xls
    98.5 KB · Affichages: 39
  • exemple fichier.xls
    98.5 KB · Affichages: 43
  • exemple fichier.xls
    98.5 KB · Affichages: 45

Staple1600

XLDnaute Barbatruc
Re : Valider l'enregistrement d'une image dans un userform

Bonjour à tous

linkon0007 [Bienvenue sur le forum]
Tu es allé jusqu'au Brésil pour trouver ton exemple ?
VBMania
Tu n'as pas trouvé d'exemple d'userform avec insertion d'image dans la langue de Molière ?
 

linkon0007

XLDnaute Nouveau
Re : Valider l'enregistrement d'une image dans un userform

Effectivement, j'ai trouvé cet exemple. le problème se situe au niveau de l'affichage de la photo après l'enregistrement si tu veux bien m'aider SVP.

Merci d'avance pour ton aide.
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…