XL 2016 Logo dans une feuille et données dans une autre

Le_Troll_Du_27

Le_Troll_Du_27

XLDnaute Occasionnel
Bonjour au forum

Je me permets de poster ce message afin de solutionner et de prendre conseil sur mon projet

1) Je souhaite ajouter une image "LOGO" dans la feuille "Images" dans la colonne D et si le contact n'a pas de logo alors charger l'image dans la feuille "Images" dans la colonne E sous le nom "Pas_Images"

VB: 
'**** 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 strFileName$
    ' Valeur de consigne pour les variables à utiliser dans GetOpenFilename Méthode
    strFileName = Application.GetOpenFilename(filefilter:= _
                                              "Tiff Files(*.tif;*.tiff),*.tif;*.tiff,JPEG Files (*.jpg;*.jpeg;*.jfif;*.jpe)," & _
                                              "*.jpg;*.jpeg;*.jfif;*.jpe,Bitmap Files(*.bmp),*.bmp", _
                                              FilterIndex:=2, _
                                              title:="Sélectionnez l'image du contact", _
                                              MultiSelect:=0)
    If strFileName = "False" Then
        MsgBox "Pas d'image sélectionnez!"
    Else
        ' Charge image pour le contrôle de l'image, en utilisant LoadPicture
        Me.Image1.Picture = LoadPicture(strFileName)
        ' 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_Image.Caption = strFileName
    End If
End Sub

2) Je souhaite pouvoir ensuite modifier et supprimer le logo si besoin et doit automatiquement chargé le logo "Pas_Images"

VB: 
'**** Correspond au programme du CommandButton "Modifier"  ****
Private Sub CmdB_Modifier_Click()        ' ........................................................Bouton Modifier
    Dim d
    TxtB_Chemin = Lbl_Image
    ' Se positionne sur la feuille
    Set Wsi = Sheets("Images")
    Set Wsl = Sheets("Listing")

    If Me.LstB_Referentiel.ListIndex = -1 Then
        Exit Sub
    Else
        Wsl.Columns("A:BR").Select: Selection.EntireColumn.Hidden = False
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(1) = TxtB1
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(2) = CmbB_Groupe_Nom
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(3) = CmbB_Civilite
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(4) = UCase(TxtB_Numero1)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(5) = Application.Proper(TxtB_Numero2)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(6) = TxtB_Numero3
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(7) = Application.Proper(TxtB_Numero4)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(8) = UCase(CmbB_Activite)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(9) = Application.Proper(TxtB_Numero5)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(10) = CmbB_Code_Postal_Domicile
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(11) = UCase(CmbB_Ville_Domicile)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(12) = CmbB_Pays_Domicile
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(13) = Application.Proper(TxtB_Numero6)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(14) = CmbB_Code_Postal_Bureau
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(15) = UCase(CmbB_Ville_Bureau)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(16) = CmbB_Pays_Bureau
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(17) = TxtB_Numero7
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(18) = TxtB_Numero8
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(19) = TxtB_Numero9
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(20) = TxtB_Numero10
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(21) = TxtB_Numero11
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(22) = TxtB_Numero12
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(23) = CStr(TxtB_Numero13)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(24) = CStr(TxtB_Numero14)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(25) = Application.Proper(TxtB_Numero15)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(26) = TxtB_Numero16
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(27) = CStr(TxtB_Numero17)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(28) = Application.Proper(TxtB_Numero18)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(29) = TxtB_Numero19
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(30) = CStr(TxtB_Numero20)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(31) = Application.Proper(TxtB_Numero21)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(32) = TxtB_Numero22
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(33) = CStr(TxtB_Numero23)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(34) = TxtB_Numero24
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(35) = TxtB_Numero25
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(36) = CmbB_Code_APE
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(37) = TxtB_Numero26
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(38) = Application.Proper(TxtB_Numero27)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(39) = CmbB_Banque
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(40) = Application.Proper(TxtB_Numero28)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(41) = TxtB_Numero29
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(42) = TxtB_Numero30
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(43) = TxtB_Numero31
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(44) = CDbl(TxtB_Numero32)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(45) = TxtB_Numero33
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(46) = TxtB_Numero34
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(47) = TxtB_Numero35
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(48) = CDate(TxtB_Date1)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(49) = CmbB_Type_Contrat
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(50) = CmbB_Statut
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(51) = CDbl(TxtB_Numero36)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(52) = CmbB_Groupe_Travail
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(53) = CmbB_Coefficient
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(54) = CmbB_Poste
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(55) = CDate(TxtB_Date2)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(56) = CDate(TxtB_Date3)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(57) = CDate(TxtB_Date4)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(58) = Application.Proper(TxtB_Numero37)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(59) = CmbB_CodeClient
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(60) = Application.Proper(TxtB_Numero38)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(61) = Application.Proper(TxtB_Numero39)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(62) = CDate(TxtB_Date5)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(63) = Application.Proper(TxtB_Numero40)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(64) = Application.Proper(TxtB_Numero41)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(65) = CDate(TxtB_Date6)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(66) = Application.Proper(TxtB_Numero42)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(67) = Application.Proper(TxtB_Numero43)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(68) = CDate(TxtB_Date7)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(69) = CDbl(TxtB1)
        Wsl.Rows(Me.LstB_Referentiel.ListIndex + 2).Columns(70) = TxtB_Chemin
        TxtB_Numero36 = Format(TxtB_Numero36.Value, "## ##0.00")
        MsgBox ("Modification prise en compte.")
        Me.LstB_Referentiel.ListIndex = -1
        '-----------------------------------------------------------------------
        Dim RowCount&, TempFile$, pic, Photo$
        Photo = "Contact"

        RowCount = Worksheets("Images").[A1].CurrentRegion.Rows.Count
        With Worksheets("Images").[A1]
            .Offset(RowCount, 0) = Me.TxtB_Numero1
            .Offset(RowCount, 1).Value = Me.TxtB_Images
            .Offset(RowCount, 2) = Me.Lbl_Image.Caption
        End With
        Me.Image1.Picture = LoadPicture("")
        Set pic = Sheets("Images").Pictures.Insert(Me.Lbl_Image.Caption)        ' sauvegarder l'image
        pic.Name = Me.TxtB_Chemin
        '-----------------------------------------------------------------------
        LstB_Referentiel.Clear

        '      With Sheets("Listing")
        '          j = 0
        '          For i = 0 To Range("A1:BO" & Range("A" & Rows.Count).End(xlUp).Row)
        '              LstB_Referentiel.AddItem .Range("A" & i + 2)
        '              For d = 1 To 6
        '                  LstB_Referentiel.List(j, d) = .Cells(i + 2, d + 1)
        '              Next d
        '              j = j + 1
        '          Next i
        '      End With
        Nettoyage_Userform1
    End If
End Sub

je vous joints le fichier en question

merci d'avance pour vos retours

PS : ceci concerne une version Office 2016 windows 10 64Bits

Cordialement
 

Pièces jointes

  • Le_Troll_Du_27 Version épuré.xlsm
    348 KB · Affichages: 82
Trier par date Trier par votes
Le_Troll_Du_27

Le_Troll_Du_27

XLDnaute Occasionnel
Bonsoir le forum
Comment récuper l'image Pas_Images dans la feuille5 pour la charger

VB: 
Private Sub LstB_Referentiel_Click()
' déclarations des variables
    Dim i As Integer
    Dim fPath As String
    Dim Image1 As String
    ' définir le chemin de fichier
    fPath = ThisWorkbook.Path & "\" & "Pictures"
    i = Me.LstB_Referentiel.ListIndex
    On Error Resume Next
    ' afficher l'image
    Me.Image1.Picture = LoadPicture(fPath & "\" & Me.LstB_Referentiel.Column(4, i) & ".jpg")
    ' Si l'image des contacts ne sont pas disponibles
    If Err = 53 Then
        Me.Image1.Picture = LoadPicture(Sheets("Images").Shape("Pas_Images"))
        'Me.Image1.Picture = LoadPicture(fPath & "\" & "Pas_Images.jpg")
    End If
    ' gestionnaire d'erreurs reset
    On Error GoTo 0
End Sub

Cordialement
 
Vote positif 0 Vote négatif

Discussions similaires

I
  • Résolu(e)
Microsoft 365 Récupérer les données des variable dans une autre feuille du classeur
Réponses
3
Affichages
437
Icedarts
I
K
  • Question
Microsoft 365 choisir une page
Réponses
6
Affichages
767
xUpsilon
xUpsilon
D
  • Question
XL 2010 rechercher du texte dans une cellule et copier la case défini dans une autre feuille
Réponses
4
Affichages
775
djodjo33
D
ARNAUD ZIRIPE
  • Question
Enregistrer, afficher et modifier des données dans un formulaire
Réponses
2
Affichages
2 K
ARNAUD ZIRIPE
ARNAUD ZIRIPE
Le_Troll_Du_27
  • Question
XL 2016 erreur ligne de commande
Réponses
4
Affichages
1 K
Theze
T
C
  • Question
XL 2013 filtrage et copiage de données dans une autre feuille excel
Réponses
13
Affichages
1 K
cedric_hiss
C
nrdz83
  • Question
afficher photo dans userform
Réponses
4
Affichages
7 K
stefan373
S
P
  • Question
extraire des données dans une feuille et les placer sous condition dans une autre
Réponses
3
Affichages
1 K
poulie
P
M
  • Question
Trier un tableau par date et copie de la selection dans une autre feuille
Réponses
1
Affichages
21 K
flyonets44
F
fourmi4x
  • Question
recherche d'une date dans une BDD et copie dans une autre feuille
Réponses
5
Affichages
1 K
fourmi4x
fourmi4x

Membres actuellement en ligne

12 membres et 76 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 095
Messages
2 116 170
Membres
112 676
dernier inscrit
little_b