Userform : formulaire + photo
Bonjour,
Je souhaite simplifier l'ajout de données dans un tableau Excel
L'idée serait d'avoir un formulaire type userform dans lequel il suffirai de rentrer les différentes données. Voici le scénario souhaité :
- Clic sur un bouton macro
- Ouverture d'un userform
- Plusieurs champs à saisir (des dimensions, un choix multiple, un nom, une photo à choisir dans un répertoire)
- Validation du userform
- En automatique : création d'une nouvelle ligne avec toutes les informations saisies et affichage de la photo dans la colonne C.
Cela vous paraît faisable ?
bonjour,
je viens de faire un essai
tester le, vous devez créer un répertoire "essai" dans le disque D et placer vos photos dans ce répertoire
si le principe vous convient, je veux bien continuer ou vous continuez vous même
Je n'arrive pas à tester votre classeur.
Je n'ai pas de disque D. Dans la configuration actuelle les images sont stockées sous un sous dossier du disque R.
Il y a divers messages d'erreurs qui apparaissent, même après que j'ai modifié D:\essai par le dossier à utiliser R:\COMMUN\BARREAUX\LISTE BARREAUX\Photos Barreaux\Barreaux
Pourquoi n'êtes vous pas parti du fichier que j'avais envoyé ? Trop gros ? Trop complexe ?
Merci pour votre essai en tout cas.
Je vous rejoins le fichier, inspiré du fichier d'origine, avec un exemple de la userform recherchée.
Il y a peut-être moyen de faire plus simple en créant une feuille "Nouvelle entrée", de remplir les nouvelles données sur cette feuille et d'avoir une action (probablement macro) de transfert de cette feuille vers une nouvelle ligne de la feuille 2020.
Mais il faut garder l'insertion de la photo, qui a mon avis est le plus difficile à faire manuellement par un novice.
Qu'en pensez vous ?
Bonjour,
Un exemple de code de l'userform :
Option Explicit
Dim NDFPhoto As String
Private Sub Annuler_Click()
Unload Me
End Sub
Private Sub Valider_Click()
Dim ligne As Long, w As Single, h As Single, t As Single, l As Single
If Range("Tableau1").Item(1, 1) <> "" Then ligne = Range("Tableau1").Rows.Count + 1 Else ligne = 1
With Worksheets("2020")
.Activate
.Range("Tableau1" & "[Nom du Barreau]").Item(ligne, 1) = TextBox1.Value
.Range("Tableau1" & "[Type]").Item(ligne, 1) = TextBox2.Value
.Range("Tableau1" & "[Carcasse]").Item(ligne, 1) = TextBox3.Value
.Range("Tableau1" & "[Moule / Tiroir]").Item(ligne, 1) = TextBox4.Value
.Range("Tableau1" & "[Longueur totale (en mm)]").Item(ligne, 1) = TextBox5.Value
.Range("Tableau1" & "[Largeur (en mm)]").Item(ligne, 1) = TextBox6.Value
.Range("Tableau1" & "[Épaisseur (en mm)]").Item(ligne, 1) = TextBox7.Value
.Range("Tableau1" & "[Volume (en litre)]").Item(ligne, 1) = TextBox8.Value
.Range("Tableau1" & "[Photo]").Item(ligne, 1).Select
.Pictures.Insert (NDFPhoto)
End With
End Sub
Private Sub Image1_Click()
NDFPhoto = ChercheImage
Image1.Picture = LoadPicture(NDFPhoto)
Me.Repaint
End Sub
Private Function ChercheImage() As String
ChercheImage = Application.GetOpenFilename(FileFilter:="JPG,*.JPG,JPEG,*.JPEG,GIF,*.GIF,BMP,*.BMP", Title:="Sélectionnez une image")
End FunctionAttention à ne pas inclure de saut de ligne dans vos entêtes de tableau.
Pour que mon code fonctionne, il faut les supprimer...
Oula !!
Je débute en VBA. Votre code est un peu compliqué pour moi.
Ce ne sera pas plus simple de passer par une feuille de saisie plutôt que par une userform ?
Il faudrait de la macro pour :
- insérer une nouvelle ligne dans le tableau base de données
- transférer les données
- insérer une image à la dimension de la cellule
- supprimer les données de la feuille de saisie
Voici un exemple de fichier
Il faudrait de la macro pour :
- insérer une nouvelle ligne dans le tableau base de données
- transférer les données
- insérer une image à la dimension de la cellule
- supprimer les données de la feuille de saisie
C'est ce que fait mon code (à part dimensionner l'image, tu ne l'avais pas demandé).
Donc, tu trouveras difficilement plus simple...
As-tu au moins essayé de :
> supprimer tes sauts de ligne dans la ligne d'entête de ton tableau
> copier-coller ce code dans ton userform
???
J'ai essayé en le copiant dans le module.
Mais cela n’apparaît pas comme une macro. Je ne peux donc pas la lancer.
Je pense que j'ai zappé une étape toute simple
Vous ne pouvez pas me l'insérer dans le dernier fichier envoyé ? Ce fichier a été créé de toute pièces pour le forum, pas de crasse.
Un Userform possède sa propre feuille de code. Pour la faire apparaître, sous VBE, double-clic sur l'userform (par exemple).
Super. Merci. C'est exactement ce que je recherchais.
J'ai juste à chercher comment redimensionner la photo comme vous l'avez fait mais en gardant les proportions.
Pour ça, remplacez le code du bouton valider :
Private Sub Valider_Click()
Dim ligne As Long, Target As Range, NomImg As String
If Range("Tableau1").Item(1, 1) <> "" Then ligne = Range("Tableau1").Rows.Count + 1 Else ligne = 1
With Worksheets("2020")
.Activate
.Range("Tableau1" & "[Nom du Barreau]").Item(ligne, 1) = TextBox1.Value
.Range("Tableau1" & "[Type]").Item(ligne, 1) = TextBox2.Value
.Range("Tableau1" & "[Carcasse]").Item(ligne, 1) = TextBox3.Value
.Range("Tableau1" & "[Moule / Tiroir]").Item(ligne, 1) = TextBox4.Value
.Range("Tableau1" & "[Longueur totale (en mm)]").Item(ligne, 1) = TextBox5.Value
.Range("Tableau1" & "[Largeur (en mm)]").Item(ligne, 1) = TextBox6.Value
.Range("Tableau1" & "[Épaisseur (en mm)]").Item(ligne, 1) = TextBox7.Value
.Range("Tableau1" & "[Volume (en litre)]").Item(ligne, 1) = TextBox8.Value
Set Target = .Cells(ligne + 1, 3)
Target.Select
NomImg = Split(NDFPhoto, "\")(UBound(Split(NDFPhoto, "\")))
NomImg = Left(NomImg, InStr(NomImg, ".") - 1)
.Pictures.Insert(NDFPhoto).Name = NomImg
.Shapes(NomImg).LockAspectRatio = msoFalse
.Shapes(NomImg).Height = Target.Height
.Shapes(NomImg).Width = Target.Width
.Shapes(NomImg).Left = Target.Left
.Shapes(NomImg).Top = Target.Top
End With
End SubA remplacer par celui-ci :
Private Sub Valider_Click()
Dim ligne As Long, Target As Range, NomImg As String
If Range("Tableau1").Item(1, 1) <> "" Then ligne = Range("Tableau1").Rows.Count + 1 Else ligne = 1
With Worksheets("2020")
.Activate
.Range("Tableau1" & "[Nom du Barreau]").Item(ligne, 1) = TextBox1.Value
.Range("Tableau1" & "[Type]").Item(ligne, 1) = TextBox2.Value
.Range("Tableau1" & "[Carcasse]").Item(ligne, 1) = TextBox3.Value
.Range("Tableau1" & "[Moule / Tiroir]").Item(ligne, 1) = TextBox4.Value
.Range("Tableau1" & "[Longueur totale (en mm)]").Item(ligne, 1) = TextBox5.Value
.Range("Tableau1" & "[Largeur (en mm)]").Item(ligne, 1) = TextBox6.Value
.Range("Tableau1" & "[Épaisseur (en mm)]").Item(ligne, 1) = TextBox7.Value
.Range("Tableau1" & "[Volume (en litre)]").Item(ligne, 1) = TextBox8.Value
Set Target = .Cells(ligne + 1, 3)
Target.Select
NomImg = Split(NDFPhoto, "\")(UBound(Split(NDFPhoto, "\")))
NomImg = Left(NomImg, InStr(NomImg, ".") - 1)
.Pictures.Insert(NDFPhoto).Name = NomImg
.Shapes(NomImg).LockAspectRatio = msoTrue
.Shapes(NomImg).Height = Target.Height
.Shapes(NomImg).Left = Target.Left
.Shapes(NomImg).Top = Target.Top
End With
End SubJ'en profite pour mettre le code en clair, pour celles et ceux qui seraient intéressé(e)s :
Option Explicit
Dim NDFPhoto As String
Private Sub Annuler_Click()
Unload Me
End Sub
Private Sub Valider_Click()
Dim ligne As Long, Target As Range, NomImg As String
If Range("Tableau1").Item(1, 1) <> "" Then ligne = Range("Tableau1").Rows.Count + 1 Else ligne = 1
With Worksheets("2020")
.Activate
.Range("Tableau1" & "[Nom du Barreau]").Item(ligne, 1) = TextBox1.Value
.Range("Tableau1" & "[Type]").Item(ligne, 1) = TextBox2.Value
.Range("Tableau1" & "[Carcasse]").Item(ligne, 1) = TextBox3.Value
.Range("Tableau1" & "[Moule / Tiroir]").Item(ligne, 1) = TextBox4.Value
.Range("Tableau1" & "[Longueur totale (en mm)]").Item(ligne, 1) = TextBox5.Value
.Range("Tableau1" & "[Largeur (en mm)]").Item(ligne, 1) = TextBox6.Value
.Range("Tableau1" & "[Épaisseur (en mm)]").Item(ligne, 1) = TextBox7.Value
.Range("Tableau1" & "[Volume (en litre)]").Item(ligne, 1) = TextBox8.Value
Set Target = .Cells(ligne + 1, 3)
Target.Select
NomImg = Split(NDFPhoto, "\")(UBound(Split(NDFPhoto, "\")))
NomImg = Left(NomImg, InStr(NomImg, ".") - 1)
.Pictures.Insert(NDFPhoto).Name = NomImg
.Shapes(NomImg).LockAspectRatio = msoTrue
.Shapes(NomImg).Height = Target.Height
.Shapes(NomImg).Left = Target.Left
.Shapes(NomImg).Top = Target.Top
End With
End Sub
Private Sub Image1_Click()
NDFPhoto = ChercheImage
Image1.Picture = LoadPicture(NDFPhoto)
Me.Repaint
End Sub
Private Function ChercheImage() As String
ChercheImage = Application.GetOpenFilename(FileFilter:="JPG,*.JPG,JPEG,*.JPEG,GIF,*.GIF,BMP,*.BMP", Title:="Sélectionnez une image")
End FunctionMaintenant, ne te reste plus qu'à traiter les cas :
> de l'absence d'image,
> des saisies erronées (valeurs numériques en F, G, H et I),
> des doublons de "Nom du Barreau",
> de la modification d'une ligne déjà saisie,
> de la suppression de ligne...
Merci beaucoup c'est exactement ça.
Pour les cas dont tu me parles, je pense que les modifications et suppressions seront faites en manuel par l'équipe qui s'occupe de ce fichier.
Normalement les autres cas (absence d'image, saisies erronées, doublons de "Nom du Barreau") ne peuvent pas avoir lieu.
Je vais actualiser ça dans mon fichier d'origine.
Merci beaucoup.
PS : Est-ce qu'il y a moyen par VBA de sélectionner "Déplacer et dimensionner avec les cellules" (dans les propriétés de l'image) ?
Pour ton ps, suffit de rajouter, en fin de code :
.Shapes(NomImg).Placement = 1Comme ceci :
Private Sub Valider_Click()
Dim ligne As Long, Target As Range, NomImg As String
If Range("Tableau1").Item(1, 1) <> "" Then ligne = Range("Tableau1").Rows.Count + 1 Else ligne = 1
With Worksheets("2020")
.Activate
.Range("Tableau1" & "[Nom du Barreau]").Item(ligne, 1) = TextBox1.Value
.Range("Tableau1" & "[Type]").Item(ligne, 1) = TextBox2.Value
.Range("Tableau1" & "[Carcasse]").Item(ligne, 1) = TextBox3.Value
.Range("Tableau1" & "[Moule / Tiroir]").Item(ligne, 1) = TextBox4.Value
.Range("Tableau1" & "[Longueur totale (en mm)]").Item(ligne, 1) = TextBox5.Value
.Range("Tableau1" & "[Largeur (en mm)]").Item(ligne, 1) = TextBox6.Value
.Range("Tableau1" & "[Épaisseur (en mm)]").Item(ligne, 1) = TextBox7.Value
.Range("Tableau1" & "[Volume (en litre)]").Item(ligne, 1) = TextBox8.Value
Set Target = .Cells(ligne + 1, 3)
Target.Select
NomImg = Split(NDFPhoto, "\")(UBound(Split(NDFPhoto, "\")))
NomImg = Left(NomImg, InStr(NomImg, ".") - 1)
.Pictures.Insert(NDFPhoto).Name = NomImg
.Shapes(NomImg).LockAspectRatio = msoFalse
.Shapes(NomImg).Height = Target.Height
.Shapes(NomImg).Width = Target.Width
.Shapes(NomImg).Left = Target.Left
.Shapes(NomImg).Top = Target.Top
.Shapes(NomImg).Placement = 1 'ICI Modif "Déplacer et dimensionner avec les cellules"
End With
End SubPARFAIT
Plus qu'à actualiser.
Merci beaucoup pour ton aide. Cela va permettre à mon fichier de continuer à vivre après mon départ de l'entreprise, sinon je suis presque sûre qu'il aurai été abandonné.
J'ai rajouté les colonne qu'il me manquait (colonne simple sans calcul), sans modifier le code et ça ne fonctionne plus.
La colonne à remplir juste après celle que j'ai ajoutée ne se rempli pas.
Bonjour,
Sans code, sans fichier, et parce que j'ai cassé ma boule de cristal, je ne parviens pas à savoir ce qui cloche...
Dans le code suivant :
.Range("Tableau1" & "[Nom du Barreau]").Item(ligne, 1) = TextBox1.ValueLa colonne du tableau "Tableau1" qui doit recevoir la données saisie dans le TextBox1, à pour Header (entête) : Nom du Barreau.
Si tu utilises cette façon de faire, tu pourras insérer des colonnes ou tu veux, comme tu veux, et autant que tu veux, la colonne "Nom du Barreau" recevra TOUJOURS la valeur saisie dans le TextBox1...
.Range("Tableau1" & "[Nom du Barreau]").Item(ligne, 1) = TextBox1.Value
.Range("Tableau1" & "[Type]").Item(ligne, 1) = ListBox1.Value
.Range("Tableau1" & "[Carcasse]").Item(ligne, 1) = TextBox3.Value
.Range("Tableau1" & "[Moule / Tiroir]").Item(ligne, 1) = TextBox4.Value
.Range("Tableau1" & "[Longueur totale (en mm)]").Item(ligne, 1) = TextBox5.Value
.Range("Tableau1" & "[Largeur (en mm)]").Item(ligne, 1) = TextBox6.Value
.Range("Tableau1" & "[Épaisseur (en mm)]").Item(ligne, 1) = TextBox7.Value
.Range("Tableau1" & "[Volume (en litre)]").Item(ligne, 1) = TextBox8.ValuePourtant avec ce code, j'ai un souci à la ligne "
.Range("Tableau1" & "[Longueur totale (en mm)]").Item(ligne, 1) = TextBox5.ValueJ'ai trouvé le problème.
Dans mes titre je retournais à la ligne avec un ALT+ENTER. J'ai remplacé cela par un espace et ça fonctionne.
j'ai un souci
Quel souci?