Complete my code VBA "Picture"

letrolldu27

letrolldu27

New Member
Joined
Sep 25, 2016
Messages
6
Hello forum

I put my problem
An array A to E
A = Name (TextBox1)
B = Line number (TextBox2)
C = Image Path (Lbl_Image)
D = Image name (Image1)
If E = No Image

I wish I built this in the code below di *
if TextBox1 column A2: A has no pictures in the paper "Images" of his assigned location of the column D2: D
then load the logo "Image1" of UserForm1 in the sheet "Images" location E2: E5 be the name "Pas_Images"

Code: 
[FONT=Courier New][COLOR=#2600ff][B]Private[/B][/COLOR] [COLOR=#2600ff][B]Sub[/B][/COLOR] CmdB_Ouvrir_Image_Click()    [/FONT][FONT=Courier New][COLOR=#008000]' Utiliser la propriété LoadPicture avec GetOpenFilename Méthode pour charger l'image à un contrôle d'image.
[/COLOR]   
[COLOR=#2600ff][B]  Dim[/B][/COLOR] strFltr [COLOR=#2600ff][B]As[/B][/COLOR] [COLOR=#2600ff][B]String[/B][/COLOR], strTtl [COLOR=#2600ff][B]As[/B][/COLOR] [COLOR=#2600ff][B]String[/B][/COLOR], strFileName [COLOR=#2600ff][B]As[/B][/COLOR] [COLOR=#2600ff][B]String[/B][/COLOR]    
[COLOR=#2600ff][B]  Dim[/B][/COLOR] iFltrIndx [COLOR=#2600ff][B]As[/B][/COLOR] [COLOR=#2600ff][B]Integer[/B][/COLOR], derlign [COLOR=#2600ff][B]As[/B][/COLOR] [COLOR=#2600ff][B]Integer[/B][/COLOR]    
[COLOR=#2600ff][B]  Dim[/B][/COLOR] bMltiSlct [COLOR=#2600ff][B]As[/B][/COLOR] [COLOR=#2600ff][B]Boolean[/B][/COLOR]    
[COLOR=#2600ff][B]  Set[/B][/COLOR] Wsi = Sheets([COLOR=#800000]"Images"[/COLOR])    [/FONT][FONT=Courier New][COLOR=#008000]' Valeur de consigne pour les variables à utiliser dans GetOpenFilename Méthode[/COLOR]    
 strFltr = [COLOR=#800000]"Tiff (*.tif;*.tiff),*.tif;*.tiff,JPEG (*.jpg;*.jpeg;*.jfif;*.jpe),*.jpg;*.jpeg;*.jfif;*.jpe,Bitmap (*.bmp),*.bmp")[/COLOR]     
  iFltrIndx = 2    
  strTtl = [COLOR=#800000]"Sélectionnez l'image du contact"[/COLOR]    
  bMltiSlct = [COLOR=#2600ff][B]False[/B][/COLOR]    [/FONT][FONT=Courier New][COLOR=#008000]' Déclaration ChDrive définit le lecteur en cours à C
[/COLOR]    
  ChDrive [COLOR=#800000]"C"[/COLOR]    [/FONT][FONT=Courier New][COLOR=#008000]' Déclaration ChDir définit le répertoire courant C:\Users\Public\Pictures\
[/COLOR]    
  ChDir [COLOR=#800000]"C:\Users\Public\Pictures\"[/COLOR]        [/FONT][FONT=Courier New][COLOR=#008000]' Utiliser GetOpenFilename Méthode pour sélectionner l'image: Logo
[/COLOR]    
  strFileName = Application.GetOpenFilename(strFltr, iFltrIndx, strTtl, , bMltiSlct)    
[COLOR=#2600ff][B]  
 On[/B][/COLOR] [COLOR=#2600ff][B]Error[/B][/COLOR] [COLOR=#2600ff][B]Resume[/B][/COLOR] [COLOR=#2600ff][B]Next[/B][/COLOR]    
[COLOR=#2600ff][B]  If[/B][/COLOR] strFileName <> [COLOR=#800000]"False"[/COLOR] [COLOR=#2600ff][B]Then[/B][/COLOR]        [/FONT][FONT=Courier New][COLOR=#008000]' Charge image pour le contrôle de l'image, en utilisant la propriété LoadPicture[/COLOR]              Me.Image1.Picture = LoadPicture(strFileName)        [/FONT][FONT=Courier New][COLOR=#008000]' Après tout changement <acronym title="visual basic for applications">vba</acronym> doit être dit pour rafraîchir la UserForm pour que le changement semble[/COLOR]        
     Me.Repaint        [/FONT][FONT=Courier New][COLOR=#008000]' Etiquette légende change après l'image est chargée[/COLOR]        
     Me.Lbl_Image.Caption = strFileName    
[COLOR=#2600ff][B]  Else[/B][/COLOR]        
     MsgBox [COLOR=#800000]"Pas d'image sélectionnez!"[/COLOR]    
[COLOR=#2600ff][B]  End[/B][/COLOR] [COLOR=#2600ff][B]If[/B][/COLOR]    [/FONT][FONT=Courier New][COLOR=#008000]' gestionnaire d'erreurs reset[/COLOR]    
[COLOR=#2600ff][B]  On[/B][/COLOR] [COLOR=#2600ff][B]Error[/B][/COLOR] [COLOR=#2600ff][B]GoTo[/B][/COLOR] 0    
[COLOR=#2600ff][B]End[/B][/COLOR] [COLOR=#2600ff][B]Sub[/B][/COLOR][/FONT]
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Sort by date Sort by votes
hello forum

pour le premier sujet l'affaire est close
Code: 
'**** Correspond au programme du CommandButton "Ouvrir Image"  ****
Private Sub CmdB_Ouvrir_Image_Click()
    ' .............................................................................................Utiliser la propriété LoadPicture avec GetOpenFilename Méthode pour charger l'image à un contrôle d'image.
    Dim strFltr As String, strTtl As String, strFileName As String
    Dim iFltrIndx As Integer, derlign As Integer
    Dim bMltiSlct As Boolean
    Set Wsi = Sheets("Images")
    ' .............................................................................................Valeur de consigne pour les variables à utiliser dans GetOpenFilename Méthode
    strFltr = "Tiff (*.tif;*.tiff),*.tif;*.tiff,JPEG (*.jpg;*.jpeg;*.jfif;*.jpe),*.jpg;*.jpeg;*.jfif;*.jpe,Bitmap (*.bmp),*.bmp"
    iFltrIndx = 2
    strTtl = "Sélectionnez l'image du contact"
    bMltiSlct = False
    ' .............................................................................................Déclaration ChDrive définit le lecteur en cours à C
    ChDrive "C"
    ' .............................................................................................Déclaration ChDir définit le répertoire courant C:\Users\Public\Pictures\
    ChDir "C:\Users\Public\Pictures\"        '
    ' .............................................................................................Utiliser GetOpenFilename Méthode pour sélectionner l'image: Logo
    strFileName = Application.GetOpenFilename(strFltr, iFltrIndx, strTtl, , bMltiSlct)
    On Error Resume Next
    If strFileName <> "False" Then
        ' .........................................................................................Charge image pour le contrôle de l'image, en utilisant la propriété LoadPicture
        Me.Image1.Picture = LoadPicture(strFileName)
        Me.Image1.PictureSizeMode = fmPictureSizeModeStretch
        ' .........................................................................................Après tout changement vba doit être dit pour rafraîchir la UserForm pour que le changement semble
        Me.Repaint
        ' .........................................................................................Etiquette légende change après l'image est chargée
        Me.Lbl_Chemin.Caption = strFileName
    Else
        MsgBox "Pas d'image sélectionnez!"
    End If
    ' .............................................................................................Gestionnaire d'erreurs reset
    On Error GoTo 0
End Sub
 
Upvote 0
Je suis avec initlistbox pour charger l'image du contact sinon charger l'image "pas images"
Code: 
'**** Correspond à l'initialisation de la ListBox "Référentiel" *****
Private Sub Initialise_LstB_Referentiel()
    ' déclarations des variables
    Dim i As Integer        ' .....................................................................
    Dim fPath As String        ' ..................................................................
    Dim Image1, Image2 As String        ' .........................................................
    Dim t As Byte        ' ........................................................................
    Sheets("Listing").Select        ' .............................................................
    With LstB_Referentiel        ' ................................................................
        TxtB1 = .List(.ListIndex, 0)        ' .....................................................Numéro de la Ligne
        CmbB_Groupe_Nom = .List(.ListIndex, 1)        ' ...........................................Groupe de la famille
        CmbB_Civilite = .List(.ListIndex, 2)        ' .............................................Civilité
        For t = 1 To 4        ' ...................................................................Nom, Prénom, Entreprise, Service
            Userform1.Controls("TxtB_Numero" & t) = .List(.ListIndex, t + 2)
        Next t        ' ...........................................................................Fin de boucle
        CmbB_Activite = .List(.ListIndex, 7)        ' .............................................Activité
        TxtB_Numero5 = .List(.ListIndex, 8)        ' ..............................................Adresse Domicile
        CmbB_Code_Postal_Domicile = .List(.ListIndex, 9)        ' .................................Code Postal Domicile
        CmbB_Ville_Domicile = .List(.ListIndex, 10)        ' ......................................Ville Domicile
        CmbB_Pays_Domicile = .List(.ListIndex, 11)        ' .......................................Pays Domicile
        TxtB_Numero6 = .List(.ListIndex, 12)        ' .............................................Adresse Bureau
        CmbB_Code_Postal_Bureau = .List(.ListIndex, 13)        ' ..................................Code Postal Bureau
        CmbB_Ville_Bureau = .List(.ListIndex, 14)        ' ........................................Ville Bureau
        CmbB_Pays_Bureau = .List(.ListIndex, 15)        ' .........................................Pays Bureau
        For t = 7 To 25        ' .............................Téléphone Domicile, Portable Domicile, Fax Domicile, Téléphone Bureau, Portable Bureau
            Userform1.Controls("TxtB_Numero" & t) = .List(.ListIndex, t + 9)        ' .............Fax Bureau, Mail, Site Web
        Next t        ' ...............Prénom du Contact 1&2&3, Téléphone du Contact 1&2&3, Adresse Mail du Contact 1&2&3, N° Siret, N° TVA Intracom
        CmbB_Code_APE = .List(.ListIndex, 35)        ' ............................................N° APE
        TxtB_Numero26 = .List(.ListIndex, 36)        ' ............................................Titulaire du Compte
        TxtB_Numero27 = .List(.ListIndex, 37)        ' ............................................Nom APE
        CmbB_Banque = .List(.ListIndex, 38)        ' ..............................................Banque
        For t = 28 To 35        ' .................................................................Domiciliation, Code Banque, Code Guichet, N° Compte
            Userform1.Controls("TxtB_Numero" & t) = .List(.ListIndex, t + 11)        ' ............Clé RIB, Code BIC, Code IBAN, N° SS
        Next t        ' ...........................................................................Fin de boucle
        TxtB_Date1 = .List(.ListIndex, 47)        ' ...............................................Date de naissance
        CmbB_Type_Contrat = .List(.ListIndex, 48)        ' ........................................Type de Contrat
        CmbB_Statut = .List(.ListIndex, 49)        ' ..............................................Statut
        TxtB_Numero36 = .List(.ListIndex, 50)        ' ............................................Salaire
        CmbB_Groupe_Travail = .List(.ListIndex, 51)        ' ......................................Coéfficient
        CmbB_Coefficient = .List(.ListIndex, 52)        ' .........................................Groupe
        CmbB_Poste = .List(.ListIndex, 53)        ' ...............................................Nom du Poste
        TxtB_Date2 = .List(.ListIndex, 54)        ' ...............................................Date d'arrivée
        TxtB_Date3 = .List(.ListIndex, 55)        ' ...............................................Date de création
        TxtB_Date4 = .List(.ListIndex, 56)        ' ...............................................Date de modification
        TxtB_Numero37 = .List(.ListIndex, 57)        ' ............................................Notes
        CmbB_CodeClient = .List(.ListIndex, 58)        ' ..........................................Code Client
        TxtB_Numero38 = .List(.ListIndex, 59)        ' ............................................Nom Enfant 1
        TxtB_Numero39 = .List(.ListIndex, 60)        ' ............................................Prénom Enfant 1
        TxtB_Date5 = .List(.ListIndex, 61)        ' ...............................................Date de naissance E1
        TxtB_Numero40 = .List(.ListIndex, 62)        ' ............................................Nom Enfant 2
        TxtB_Numero41 = .List(.ListIndex, 63)        ' ............................................Prénom Enfant 2
        TxtB_Date6 = .List(.ListIndex, 64)        ' ...............................................Date de naissance E2
        TxtB_Numero42 = .List(.ListIndex, 65)        ' ............................................Nom Enfant 3
        TxtB_Numero43 = .List(.ListIndex, 66)        ' ............................................Prénom Enfant 3
        TxtB_Date7 = .List(.ListIndex, 67)        ' ...............................................Date de naissance E3
        TxtB_Images = .List(.ListIndex, 68)        ' ..............................................N° de l'image
        TxtB_Chemin = .List(.ListIndex, 69)        ' ..............................................Chemin de l'image
        TxtB_Numero36 = Format(TxtB_Numero36.Value, "## ##0.00€")        ' ........................
        TxtB_Numero1.SetFocus        ' ............................................................
    End With        ' .............................................................................
    ' .............................................................................................Définir le chemin de fichier
    fPath = ThisWorkbook.Path & "\" & TxtB_Numero1.Value        ' .................................
    i = Me.LstB_Referentiel.ListIndex        ' ....................................................
    On Error Resume Next        ' .................................................................
    ' .............................................................................................Afficher l'image
    
    ' .............................................................................................Gestionnaire d'erreurs reset
    On Error GoTo 0        ' ......................................................................
    CmdB_Supprimer.Enabled = True        ' ........................................................Bouton dévérouillé
    CmdB_Nouveau.Enabled = False        ' .........................................................Bouton vérouillé
    CmdB_Modifier.Enabled = True        ' .........................................................Bouton dévérouillé
End Sub

c'est ici que j'ai un problème :

Code: 
If Image1 <> "" Then        ' ........Dir(Fichier) <> "" Then OU If Me.Image1.Picture Is Nothing Then
        With Sheets("Images")
            ' .....................................................................................Si le fichier existe, il est chargé pour visualisation.
            Me.Image1.Picture = LoadPicture(TxtB_Numero1.Text & ".bmp;.jpg;.jpeg;.jfif;.jpe;.tif;.tiff")
            'Image1.Picture = LoadPicture(fPath & "\" & Me.LstB_Referentiel.Column(3, i) & ".bmp;.jpg;.jpeg;.jfif;.jpe;.tif;.tiff")        ' (Fichier)
            ' Me.Image1.Picture = LoadPicture(strFileName)
            ' Me.Image1.Picture = LoadPicture(Sheets(5).TxtB_Numero1.Value)
            Me.Image1.Visible = True        ' .....................................................Affiche Image1
            Me.Image2.Visible = False        ' ....................................................Masque Image2
        End With
    Else        ' .................................................................................Si l'image des contacts ne sont pas disponibles
        With Sheets("Images")
            Me.Image2.Picture = Sheets(5).PasImages.Picture        ' ..............................Charge PasImages dans l'Image2
            Me.Image2.Visible = True        ' .....................................................Affiche Image2
            Me.Image1.Visible = False        ' ....................................................Masque Image1
        End With
    End If

merci

cordialy
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Question
image hyperlink inserted from User form wont open
Replies
2
Views
766
hsolanki
H
H
  • Question
Image hyperlink wont open
Replies
0
Views
670
hsolanki
H
H
  • Question
Add image from Userform to corresponding data entered on each row
Replies
1
Views
1K
Worf
Worf
R
  • Question
LoadPicture Save Picture does not work in userform
Replies
2
Views
4K
Ritzl
R
W
  • Question
Picture in A1, display picture in different cell via formula?
Replies
0
Views
712
Windy Skies
W

Forum statistics

Threads
1,215,029
Messages
6,122,755
Members
449,094
Latest member
dsharae57

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top