cs_warzet
Messages postés99Date d'inscriptionjeudi 17 janvier 2008StatutMembreDernière intervention25 juillet 2013
-
31 janv. 2010 à 09:27
cs_warzet
Messages postés99Date d'inscriptionjeudi 17 janvier 2008StatutMembreDernière intervention25 juillet 2013
-
31 janv. 2010 à 18:51
Bonjour à tous.
Je voudrais vs dire que je ne suis qu'un ptit débutant, autodictacte, aussi je souhaiterais avoir votre indulgence. Voici ma préoccupation actuelle.
J'ai écrit avce l'aide de vous tous le code ci-dessous pour sauvegarder une image dans une base Access en binaire ds champ Olé et ça marche. Mon problème, est que je n'arrive pas à récupérer l'image pour l'afficher dans la Frm.
Code Enrg:
'Déclaration d'une instance du recordset et ajout d'enregistrement
Set Stm = New ADODB.Stream
Set Rs = New ADODB.Recordset
Req = "select * From Personnels Where Matricule Like '" & TxtPers(4).Text & "'"
Rs.Open Req, Cnx, adOpenKeyset, adLockOptimistic, adCmdText
'vérification du doublons
If Rs!Matricule = TxtPers(4).Text Then
MsgBox "Le " & UCase(TxtGrade.Text) & " " & UCase(TxtPers(2).Text) & " " & UCase(TxtPers(3).Text) & vbCrLf & " Matricule : " & UCase(TxtPers(4).Text) & vbCrLf & " Est déjà Enregistré dans la Base DMIR", vbInformation
ViderCtrl
TxtPhoto.Caption = ""
Photo.Picture = Nothing
Exit Sub
End If
If Rs!Mecano = TxtPers(5).Text Then
MsgBox "Le " & UCase(TxtGrade.Text) & " " & UCase(TxtPers(2).Text) & " " & UCase(TxtPers(3).Text) & vbCrLf & " Matricule : " & UCase(TxtPers(4).Text) & vbCrLf & " Est déjà Enregistré dans la Base DMIR", vbInformation
ViderCtrl
TxtPhoto.Caption = ""
Photo.Picture = Nothing
Exit Sub
End If
Dans un Module:
Option Explicit
Dim sTemporyFileName As String
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" _
(ByVal LpszPath As String, ByVal LpPrefixString As String, ByVal wUnique As Long, _
ByVal LpTempFileName As String) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const MAX_PATH = 260
et Ceci pour Récupérer l'image
Public Function GenerateTemporyFileName(Optional Prefix As String = "TMP") As String
Dim sBuffer As String
Dim sTempFolderPath As String
If GetTempPath(MAX_PATH, sTempFolderPath) Then
If GetTempFileName(sTempFolderPath, Prefix, 0&, sBuffer) Then
GenerateTemporyFileName = Left$(sBuffer, InStr(1, sBuffer, Chr$(0)) - 1)
End If
End If
End Function
Pour l'Affichage, je par d'un MsFlex comme ceci
Private Sub MsPers_Click()
On Error Resume Next
Set Stm = New ADODB.Stream
Set Rsd = New ADODB.Recordset
Req = "SELECT * FROM Personnel WHERE NumPers like '" & MsPers.Text & "'"
Rsd.Open Req, Cnx, adOpenKeyset, adLockOptimistic, adCmdText
Stm.Open
'Stm.Write Rsd.Fields("Photo1").Value
Rsd.MoveFirst
If Not IsNull(Rsd!NumPers) Then TxtPers.Item(0).Text = (Rsd!NumPers)
If Not IsNull(Rsd!Grade) Then CboGrade.Text = UCase(Rsd!Grade)
If Not IsNull(Rsd!Nom) Then TxtPers.Item(2).Text = UCase(Rsd!Nom)
If Not IsNull(Rsd!Prenom) Then TxtPers.Item(3).Text = UCase(Rsd!Prenom)
If Not IsNull(Rsd!Matricule) Then TxtPers.Item(4).Text = UCase(Rsd!Matricule)
If Not IsNull(Rsd!Mecano) Then TxtPers.Item(5).Text = UCase(Rsd!Mecano)
If Not IsNull(Rsd!DateNais) Then DateNais.Text = (Rsd!DateNais)
If Not IsNull(Rsd!NomLieu) Then CboLieu.Text = UCase(Rsd!NomLieu)
If Not IsNull(Rsd!NomPere) Then TxtPers.Item(8).Text = UCase(Rsd!NomPere)
If Not IsNull(Rsd!NomMere) Then TxtPers.Item(9).Text = UCase(Rsd!NomMere)
If Not IsNull(Rsd!Ethnie) Then CboEthnie.Text = UCase(Rsd!Ethnie)
'If Not IsNull(Rsd!Taille) Then Taille.Text = UCase(Rsd!Taille)
If Not IsNull(Rsd!DateEntree) Then EntreeService.Text = UCase(Rsd!DateEntree)
If Not IsNull(Rsd!DatePromo) Then DatePromo.Text = (Rsd!DatePromo)
If Not IsNull(Rsd!GrpeSanguin) Then CboRhesus.Text = UCase(Rsd!GrpeSanguin)
If Not IsNull(Rsd!NomReligion) Then CboReligion.Text = UCase(Rsd!NomReligion)
If Not IsNull(Rsd!Situation) Then CboPosition.Text = UCase(Rsd!Situation)
If Not IsNull(Rsd!NomSection) Then CboSection.Text = UCase(Rsd!NomSection)
If Not IsNull(Rsd!NiveauScolaire) Then CboNiveau.Text = UCase(Rsd!NiveauScolaire)
If Not IsNull(Rsd!Specialite) Then CboSpecialite.Text = UCase(Rsd!Specialite)
If Not IsNull(Rsd!Diplome) Then CboDiplome.Text = UCase(Rsd!Diplome)
If Not IsNull(Rsd!Fonction) Then CboFonction.Text = UCase(Rsd!Fonction)
If Not IsNull(Rsd!Famille) Then CboFamille.Text = UCase(Rsd!Famille)
If Not IsNull(Rsd!Categorie) Then CboCategorie.Text = UCase(Rsd!Categorie)
If Not IsNull(Rsd!CorpsOrigine) Then CboCorps.Text = UCase(Rsd!CorpsOrigine)
If Not IsNull(Rsd!DateEng) Then DateEng.Text = (Rsd!DateEng)
'If Not IsNull(Rsd!NbEnft) Then NbEnfts.Text = UCase(Rsd!NbEnft)
If Not IsNull(Rsd!Surnom) Then TxtPers.Item(26).Text = UCase(Rsd!Surnom)
'If Not IsNull(Rsd!Photo) Then TxtPhoto.Caption = Rsd!Photo
If Not IsNull(Rsd.Fields("Photo1").Value) Then Stm.Write Rsd.Fields("Photo1").Value
sTemporyFileName = GenerateTemporyFileName("PGM")
Stm.SaveToFile sTemporyFileName, adSaveCreateOverWrite And adSaveCreateNotExist
Set Photo.Picture = LoadPicture(sTemporyFileName)
Kill sTemporyFileName
'If Rsd!Photo = "" Then
'TxtPhoto.Caption = ""
'End If
'If TxtPhoto.Caption = "" Then
'Photo.Picture = Nothing
'Else
'Photo.Picture = LoadPicture(TxtPhoto.Caption)
'End If
Rsd.Close
Stm.Close
Set Rsd = Nothing
Set Stm = Nothing
End Sub
J'ai une Erreur [ Run-time error "3219" Operation is not allowed in this Context. ]
Aidez moi s'il vous plait. Je souhaiterais apprendre. Merci à tous de me repondre, même par mail. E-mail: laurent_guehi@yahoo.fr
