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

Le_Troll_Du_27 · 26 Septembre 2016

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

Le_Troll_Du_27 · 27 Septembre 2016

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

Le_Troll_Du_27 · 28 Septembre 2016

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

Le_Troll_Du_27

XLDnaute Occasionnel

Pièces jointes

Le_Troll_Du_27

XLDnaute Occasionnel

Le_Troll_Du_27

XLDnaute Occasionnel

Discussions similaires