Inserer une image si pas image
- Messages
- 156
- Excel
- 2019 FR 64 Bits
- Inscrit
- 14/07/2015
- Emploi
- Ex-Conducteur Routier de convoi exceptionnel
Bonjour le forum
Je pose mon problème
Un tableau de A à E
A = Nom (TextBox1)
B = Numéro de ligne (TextBox2)
C = Chemin de l'image (Lbl_Image)
D= Image du Nom (Image1)
E = Si Pas Image
Je souhaiterai intégré ceci dans le code di*dessous
si TextBox1 en colonne A2:A n'a pas d'images dans la feuille "Images" de son emplacement attribué de la colonne D2:D
alors charge le logo dans "Image1" de l'userform1 dans la feuille "Images" l'emplacement E2:E5 soit le nom "Pas_Images"
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)
' 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
Else
MsgBox "Pas d'image sélectionnez!"
End If
' gestionnaire d'erreurs reset
On Error GoTo 0
End Sub
Cordialement
- Messages
- 156
- Excel
- 2019 FR 64 Bits
- Inscrit
- 14/07/2015
- Emploi
- Ex-Conducteur Routier de convoi exceptionnel
Bonjour le forum
Up!
Je suis coincé , Merci
Cordialement
- Messages
- 156
- Excel
- 2019 FR 64 Bits
- Inscrit
- 14/07/2015
- Emploi
- Ex-Conducteur Routier de convoi exceptionnel
Bonjour le forum
je viens au nouvelle
cordialement
Bonjour,
Je ne comprends pas tout, comme tu n'as pas mis de fichier exemple, c'est beaucoup plus difficile de comprendre précisément ton besoin, surtout que j'ai du mal avec tes explications :
si TextBox1 en colonne A2:A n'a pas d'images dans la feuille "Images" de son emplacement attribué de la colonne D2:D
alors charge le logo dans "Image1" de l'userform1 dans la feuille "Images" l'emplacement E2:E5 soit le nom "Pas_Images"
Si on ne trouve pas l'image en colonne D, tu veux qu'on affiche un logo dans image1 ? Si oui, ou est-il ? Dans un dossier ? Du coup on ne le cherche plus sur le disque (méthode GetOpenFilename) ?
- Messages
- 156
- Excel
- 2019 FR 64 Bits
- Inscrit
- 14/07/2015
- Emploi
- Ex-Conducteur Routier de convoi exceptionnel
Bonjour le forum
Benead a écrit :Si on ne trouve pas l'image en colonne D, tu veux qu'on affiche un logo dans image1 ? Si oui, ou est-il ? Dans un dossier ?
Apres réflexion oui dans un dossier pourquoi pas car je pense que les images dans le fichier ne ferai qu'alourdir le fichier
Je te joins le fichier si tu souhaites regardé
Cordialement
J'ai regardé ton fichier, j'ai du code qui bug, par exemple cette ligne
parce qu'un label n'a pas de propriété "Value", c'est Caption qu'il faut mettre.TxtB_Chemin = Lbl_Image.Value
Sinon tu n'as pas vraiment précisé ta demande. Je vais donc essayer de l'interpréter :
Si tu veux afficher un logo quand il n'existe pas de photo de contact ,le plus simple est d'afficher un second contrôle image (Image2) avec le logo que tu souhaites et en une seule fois (tu insères le contrôle Image, tu le positionnes et tu vas chercher l'image en cliquant sur le bouton Picture, tout ça dans la fenêtre VBE). Ensuite, dans ton code d'affichage d'intitialisation du formulaire tu affiches l'image2 et quand tu choisis un contact, si tu trouves une photo du contact, tu masques Image2 et tu affiches Image1 après l'avoir chargée dans le contrôle. Je ne peux pas te rendre ton classeur corrigé car j'ai je n'ai pas les photos, mais concrètement cela donne ça quand tu cliques sur un nom :
If Me.Image1.Picture Is Nothing Then
Image2.Visible = True
Me.Image1.Visible = False
Else
Image2.Visible = False
Me.Image1.Visible = True
End If
Sinon évite de déclarer des variables portant des noms existants comme Image1 :
Private Sub LstB_Referentiel_Click()
' déclarations des variables
Dim I As Integer
Dim fPath As String
Dim Image1 As String
- Messages
- 156
- Excel
- 2019 FR 64 Bits
- Inscrit
- 14/07/2015
- Emploi
- Ex-Conducteur Routier de convoi exceptionnel
bonjour le forum, salut Benead
Pour cette partie
Benead a écrit :J'ai regardé ton fichier, j'ai du code qui bug, par exemple cette ligne
parce qu'un label n'a pas de propriété "Value", c'est Caption qu'il faut mettre.TxtB_Chemin = Lbl_Image.Value
juste une erreur rectifié, c'est juste un oublie car il y avait un autre codage ici.
Benead a écrit :Si tu veux afficher un logo quand il n'existe pas de photo de contact ,le plus simple est d'afficher un second contrôle image (Image2)
Je n'ai vraiment pas pensé à çà.
Ca donne donc ceci
'**** 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)
CmbB_Groupe_Nom = .List(.ListIndex, 1)
CmbB_Civilite = .List(.ListIndex, 2)
For t = 1 To 4
Userform1.Controls("TxtB_Numero" & t) = .List(.ListIndex, t + 2)
Next t
CmbB_Activite = .List(.ListIndex, 7)
TxtB_Numero5 = .List(.ListIndex, 8)
CmbB_Code_Postal_Domicile = .List(.ListIndex, 9)
CmbB_Ville_Domicile = .List(.ListIndex, 10)
CmbB_Pays_Domicile = .List(.ListIndex, 11)
TxtB_Numero6 = .List(.ListIndex, 12)
CmbB_Code_Postal_Bureau = .List(.ListIndex, 13)
CmbB_Ville_Bureau = .List(.ListIndex, 14)
CmbB_Pays_Bureau = .List(.ListIndex, 15)
For t = 7 To 25
Userform1.Controls("TxtB_Numero" & t) = .List(.ListIndex, t + 9)
Next t
CmbB_Code_APE = .List(.ListIndex, 35)
TxtB_Numero26 = .List(.ListIndex, 36)
TxtB_Numero27 = .List(.ListIndex, 37)
CmbB_Banque = .List(.ListIndex, 38)
For t = 28 To 35
Userform1.Controls("TxtB_Numero" & t) = .List(.ListIndex, t + 11)
Next t
TxtB_Date1 = .List(.ListIndex, 47)
CmbB_Type_Contrat = .List(.ListIndex, 48)
CmbB_Statut = .List(.ListIndex, 49)
TxtB_Numero36 = .List(.ListIndex, 50)
CmbB_Groupe_Travail = .List(.ListIndex, 51)
CmbB_Coefficient = .List(.ListIndex, 52)
CmbB_Poste = .List(.ListIndex, 53)
TxtB_Date2 = .List(.ListIndex, 54)
TxtB_Date3 = .List(.ListIndex, 55)
TxtB_Date4 = .List(.ListIndex, 56)
TxtB_Numero37 = .List(.ListIndex, 57)
CmbB_CodeClient = .List(.ListIndex, 58)
TxtB_Numero38 = .List(.ListIndex, 59)
TxtB_Numero39 = .List(.ListIndex, 60)
TxtB_Date5 = .List(.ListIndex, 61)
TxtB_Numero40 = .List(.ListIndex, 62)
TxtB_Numero41 = .List(.ListIndex, 63)
TxtB_Date6 = .List(.ListIndex, 64)
TxtB_Numero42 = .List(.ListIndex, 65)
TxtB_Numero43 = .List(.ListIndex, 66)
TxtB_Date7 = .List(.ListIndex, 67)
TxtB_Images = .List(.ListIndex, 68)
TxtB_Chemin = .List(.ListIndex, 69)
TxtB_Numero36 = Format(TxtB_Numero36.Value, "## ##0.00€")
TxtB_Numero3.SetFocus
End With
' 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
Me.Image2.Picture = Sheets(5).PasImages.Picture
If Me.Image1.Picture Is Nothing Then
Me.Image2.Visible = True
Me.Image1.Visible = False
Else
Me.Image2.Visible = False
Me.Image1.Visible = True
End If
' 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
Pour l'enregistrer l'image sélectionné je comprends pas pourquoi l'image ce trouve dans la colonne BR de la feuille Image
'**** Correspond au programme du CommandButton "Nouveau" ****
Private Sub CmdB_Nouveau_Click() ' .........................................................Bouton Nouveau
Dim NbLignes, LaLigne As Integer ' .....................................................Déclare la variable NbLignes (Incrément)
Dim Condition, pic
TxtB_Chemin = Lbl_Image
If MsgBox(" Confirmez-vous l’insertion de ce nouveau contact ? ", vbYesNo, _
" Demande de confirmation d’ajout ") = vbYes Then
' définir un groupe obligatoire
If CmbB_Groupe_Nom.ListIndex = -1 Then
Condition = MsgBox("Vous n'avez pas défini de groupe ...", 48, "Erreur")
Exit Sub
End If ' ...........................................................................Fin de la condition
' au moins un champs à remplir
If TxtB_Numero1 = "" And TxtB_Numero2 = "" And TxtB_Numero3 = "" Then
Condition = MsgBox("Complétez impérativement l'un des champs suivants :" & Chr(10) & _
Chr(10) & " - Nom" & Chr(10) & " - Prénom" & Chr(10) & " - Entreprise", 48, "Erreur")
Exit Sub
End If ' ...........................................................................Fin de la condition
Set Wsd = Sheets("Données")
Set Wsl = Sheets("Listing")
Set Wsi = Sheets("Images")
NbLignes = Wsl.Range("A" & Rows.Count).End(xlUp).Row + 1
LaLigne = Wsi.Range("A" & Rows.Count).End(xlUp).Row + 1
Wsl.Range("A" & NbLignes) = Wsl.Range("A" & NbLignes - 1) + 1 ' ....................Numéro de la Ligne
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Wsl.Range("B" & NbLignes) = CmbB_Groupe_Nom.Value ' ................................Groupe de la famille
Wsl.Range("C" & NbLignes) = CmbB_Civilite.Value ' ..................................Civilité
Wsl.Range("D" & NbLignes) = TxtB_Numero1.Value ' ...................................Nom
Wsl.Range("E" & NbLignes) = TxtB_Numero2.Value ' ...................................Prénom
Wsl.Range("F" & NbLignes) = TxtB_Numero3.Value ' ...................................Entreprise
Wsl.Range("G" & NbLignes) = TxtB_Numero4.Value ' ...................................Service
Wsl.Range("H" & NbLignes) = CmbB_Activite.Value ' ..................................Activité
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Wsl.Range("I" & NbLignes) = TxtB_Numero5.Value ' ...................................Adresse Domicile
Wsl.Range("J" & NbLignes) = CmbB_Code_Postal_Domicile.Value ' ......................Code Postal Domicile
Wsl.Range("K" & NbLignes) = CmbB_Ville_Domicile.Value ' ............................Ville Domicile
Wsl.Range("L" & NbLignes) = Me.CmbB_Pays_Domicile.Value ' ..........................Pays Domicile
Wsl.Range("M" & NbLignes) = TxtB_Numero6.Value ' ...................................Adresse Bureau
Wsl.Range("N" & NbLignes) = CmbB_Code_Postal_Bureau.Value ' ........................Code Postal Bureau
Wsl.Range("O" & NbLignes) = CmbB_Ville_Bureau.Value ' ..............................Ville Bureau
Wsl.Range("P" & NbLignes) = CmbB_Pays_Bureau.Value ' ...............................Pays Bureau
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Wsl.Range("Q" & NbLignes) = TxtB_Numero7.Value ' ...................................Téléphone Domicile
Wsl.Range("R" & NbLignes) = TxtB_Numero8.Value ' ...................................Portable Domicile
Wsl.Range("S" & NbLignes) = TxtB_Numero9.Value ' ...................................Fax Domicile
Wsl.Range("T" & NbLignes) = TxtB_Numero10.Value ' ..................................Téléphone Bureau
Wsl.Range("U" & NbLignes) = TxtB_Numero11.Value ' ..................................Portable Bureau
Wsl.Range("V" & NbLignes) = TxtB_Numero12.Value ' ..................................Fax Bureau
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Wsl.Range("W" & NbLignes) = TxtB_Numero13.Value ' ..................................Mail
Wsl.Range("X" & NbLignes) = TxtB_Numero14.Value ' ..................................Site Web
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Wsl.Range("Y" & NbLignes) = TxtB_Numero15.Value ' ..................................Prénom du Contact 1
Wsl.Range("Z" & NbLignes) = TxtB_Numero16.Value ' ..................................Téléphone du Contact 1
Wsl.Range("AA" & NbLignes) = TxtB_Numero17.Value ' .................................Adresse Mail du Contact 1
Wsl.Range("AB" & NbLignes) = TxtB_Numero18.Value ' .................................Prénom du Contact 2
Wsl.Range("AC" & NbLignes) = TxtB_Numero19.Value ' .................................Téléphone du Contact 2
Wsl.Range("AD" & NbLignes) = TxtB_Numero20.Value ' .................................Adresse Mail du Contact 2
Wsl.Range("AE" & NbLignes) = TxtB_Numero21.Value ' .................................Prénom du Contact 3
Wsl.Range("AF" & NbLignes) = TxtB_Numero22.Value ' .................................Téléphone du Contact 3
Wsl.Range("AG" & NbLignes) = TxtB_Numero23.Value ' .................................Adresse Mail du Contact 3
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Wsl.Range("AH" & NbLignes) = TxtB_Numero24.Value ' .................................N° Siret
Wsl.Range("AI" & NbLignes) = TxtB_Numero25.Value ' .................................N° TVA Intracom
Wsl.Range("AJ" & NbLignes) = CmbB_Code_APE.Value ' .................................N° APE
Wsl.Range("AK" & NbLignes) = TxtB_Numero26.Value ' .................................Nom APE
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Wsl.Range("AL" & NbLignes) = TxtB_Numero27.Value ' .................................Titulaire du Compte
Wsl.Range("AM" & NbLignes) = CmbB_Banque.Value ' ...................................Banque
Wsl.Range("AN" & NbLignes) = TxtB_Numero28.Value ' .................................Domiciliation
Wsl.Range("AO" & NbLignes) = TxtB_Numero29.Value ' .................................Code Banque
Wsl.Range("AP" & NbLignes) = TxtB_Numero30.Value ' .................................Code Guichet
Wsl.Range("AQ" & NbLignes) = TxtB_Numero31.Value ' .................................N° Compte
Wsl.Range("AR" & NbLignes) = TxtB_Numero32.Value ' .................................Clé RIB
Wsl.Range("AS" & NbLignes) = TxtB_Numero33.Value ' .................................Code BIC
Wsl.Range("AT" & NbLignes) = TxtB_Numero34.Value ' .................................Code IBAN
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Wsl.Range("AU" & NbLignes) = TxtB_Numero35.Value ' .................................N° SS
If Not Me.TxtB_Date1.Value = "" Then Wsl.Range("AV" & NbLignes) = CDate(Me.TxtB_Date1.Value)
Wsl.Range("AW" & NbLignes) = CmbB_Type_Contrat.Value ' .............................Type de Contrat
Wsl.Range("AX" & NbLignes) = CmbB_Statut.Value ' ...................................Statut
If Not Me.TxtB_Numero36.Value = "" Then Wsl.Range("AY" & NbLignes) = CDbl(TxtB_Numero36.Value)
Wsl.Range("AZ" & NbLignes) = CmbB_Coefficient.Value ' ..............................Coéfficient
Wsl.Range("BA" & NbLignes) = CmbB_Groupe_Travail.Value ' ...........................Groupe
Wsl.Range("BB" & NbLignes) = CmbB_Poste.Value ' ....................................Nom du Poste
If Not Me.TxtB_Date2.Value = "" Then Wsl.Range("BC" & NbLignes) = CDate(Me.TxtB_Date2.Value)
Wsl.Range("BD" & NbLignes) = CDate(Now) ' ..........................................Date de création
If Not Me.TxtB_Date4.Value = "" Then Wsl.Range("BE" & NbLignes) = CDate(Me.TxtB_Date4.Value)
Wsl.Range("BF" & NbLignes) = TxtB_Numero37.Value ' .................................Notes
Wsl.Range("BG" & NbLignes) = CmbB_CodeClient.Value ' ...............................Code Client
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Wsl.Range("BH" & NbLignes) = TxtB_Numero38.Value ' .................................Nom Enfant 1
Wsl.Range("BI" & NbLignes) = TxtB_Numero39.Value ' .................................Prénom Enfant 1
If Not Me.TxtB_Date5.Value = "" Then Wsl.Range("BJ" & NbLignes) = CDate(Me.TxtB_Date5.Value)
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Wsl.Range("BK" & NbLignes) = TxtB_Numero40.Value ' .................................Nom Enfant 2
Wsl.Range("BL" & NbLignes) = TxtB_Numero41.Value ' .................................Prénom Enfant 2
If Not Me.TxtB_Date6.Value = "" Then Wsl.Range("BM" & NbLignes) = CDate(Me.TxtB_Date6.Value)
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Wsl.Range("BN" & NbLignes) = TxtB_Numero42.Value ' .................................Nom Enfant 3
Wsl.Range("BO" & NbLignes) = TxtB_Numero43.Value ' .................................Prénom Enfant 3
If Not Me.TxtB_Date7.Value = "" Then Wsl.Range("BP" & NbLignes) = CDate(Me.TxtB_Date7.Value)
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Si l'image n'est pas chargé le chemin est vide
If Not Me.TxtB_Chemin.Value = "" Then Wsl.Range("BQ" & NbLignes) = Wsl.Range("A" & NbLignes - 1) + 1
If Not Me.TxtB_Chemin.Value = "" Then Wsl.Range("BR" & NbLignes) = TxtB_Chemin.Value
If Not Me.TxtB_Chemin.Value = "" Then Wsi.Range("A" & LaLigne) = TxtB_Numero1.Value
If Not Me.TxtB_Chemin.Value = "" Then Wsi.Range("B" & LaLigne) = Wsl.Range("A" & NbLignes - 1) + 1
If Not Me.TxtB_Chemin.Value = "" Then Wsi.Range("C" & LaLigne) = TxtB_Chemin.Value
' -----------------------------------------------------------------------------------------
If Not Me.TxtB_Chemin.Value = "" Then
Set pic = Sheets("Images").Pictures.Insert(Me.Lbl_Image.Caption) ' sauvegarder l'image
pic.name = Me.TxtB_Numero1
Wsi.Range("D" & LaLigne) = Image1.Picture
End If
' -----------------------------------------------------------------------------------------
Condition = MsgBox("Les données ont bien été enregistrées.", 64, "Confirmation")
End If ' ...............................................................................Fin de la condition
'**********************************************************************************************
'* Format *
'**********************************************************************************************
CmbB_Code_Postal_Domicile = Format(CmbB_Code_Postal_Domicile.Value, "00 000")
CmbB_Code_Postal_Bureau = Format(CmbB_Code_Postal_Bureau.Value, "00 000")
TxtB_Numero36 = Format(TxtB_Numero36.Value, "## ##0.00")
TxtB_Date1 = Format(TxtB_Date1.Value, "dd/mm/yyyy")
TxtB_Date2 = Format(TxtB_Date2.Value, "dd/mm/yyyy")
TxtB_Date3 = Format(TxtB_Date3.Value, "dd/mm/yyyy")
TxtB_Date4 = Format(TxtB_Date4.Value, "dd/mm/yyyy")
TxtB_Date5 = Format(TxtB_Date5.Value, "dd/mm/yyyy")
TxtB_Date6 = Format(TxtB_Date6.Value, "dd/mm/yyyy")
TxtB_Date7 = Format(TxtB_Date6.Value, "dd/mm/yyyy")
Nettoyage_Userform1
End Sub
et je souhaiterai que l'image prenne la place d'une cellule sur la hauteur et largeur
Cordialement
Bonsoir,
Si l'image se positionne en colonne BR, c'est parce que c'est la colonne de la cellule active. Voici la correction avec repositionnement :
If Not Me.TxtB_Chemin.Value = "" Then
Set pic = Sheets("Images").Pictures.Insert(Me.Lbl_Image.Caption) ' sauvegarder l'image
pic.name = Me.TxtB_Numero1
With pic
.ShapeRange.LockAspectRatio = msoFalse ' Autorisation des disproportions de l'image (ne respecte pas les proportions se l'image
.Top = Wsi.Range("D" & LaLigne).Top
.Left = Wsi.Range("D" & LaLigne).Left
.Width = Wsi.Range("D" & LaLigne).Width
.Height = Wsi.Range("D" & LaLigne).Height
End With
End If
Attention : Ton fichier va s'alourdir très vite si tu mets beaucoup d'images !
- Messages
- 156
- Excel
- 2019 FR 64 Bits
- Inscrit
- 14/07/2015
- Emploi
- Ex-Conducteur Routier de convoi exceptionnel
Bonsoir le forum, le fil, Benead
C'est parfait.
je commence à comprendre à les images. merci encore
Cordialement