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
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
