Copie image d'un Userform vers une cellule Excel
Bonjour à tous,
Je suis débutant dans les macros Excel et suis bloqué.
J'ai créé un Userform pour la saisie d'un nouvel arrivant.
On rentre les informations et on va avec un bouton chercher la photo de la personne.
Cette photo est insérée dans une image du formulaire.
Une boucle va chercher la première cellule vide et enregistre les info du formulaire.
Je ne sais pas comment affecter à la valeur ActiveCell.Offset(0, 7) l'image contenue dans le userform.
Voici le code complet de mon projet.
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
| Sub Chercher_Image_Click()
On Error Resume Next
ChoixImage = Application.GetOpenFilename(",*.jpg")
If ChoixImage = "" Then Exit Sub
Ajout_Accueil_Sécu.New_Accueil_Photo.Picture = LoadPicture(ChoixImage, 78, 180)
End Sub
Private Sub New_Accueil_Annuler_Click()
Unload Ajout_Accueil_Sécu
End Sub
Private Sub New_Accueil_Enregistrer_Click()
Dim Num_Badge As Integer
Dim i As Integer
i = 1
Worksheets("Accueil_Sécu").Select
Do While Cells(i, 1) <> ""
Cells(i, 1).Offset(1, 1).Select
i = i + 1
Loop
ActiveCell.Value = Ajout_Accueil_Sécu.New_Accueil_Entreprise.Value
ActiveCell.Offset(0, 1).Value = Ajout_Accueil_Sécu.New_Accueil_Nom.Value
ActiveCell.Offset(0, 2).Value = Ajout_Accueil_Sécu.New_Accueil_Prénom.Value
ActiveCell.Offset(0, 3).Value = Ajout_Accueil_Sécu.New_Accueil_Fonction.Value
ActiveCell.Offset(0, 4).Value = Ajout_Accueil_Sécu.New_Accueil_Date.Value
ActiveCell.Offset(0, 5).Value = Ajout_Accueil_Sécu.New_Accueil_Validité.Value
ActiveCell.Offset(0, 6).Value = Ajout_Accueil_Sécu.New_Accueil_Couleur_Badge.Value
ActiveCell.Offset(0, 7).Value = Ajout_Accueil_Sécu.New_Accueil_Téléphone.Value
ActiveCell.Offset(0, 8).Value = LoadPicture(ChoixImage, 78, 180)
If ActiveCell.Offset(-1, -1).Value = "Num_Badge" Then
ActiveCell.Offset(0, -1).Value = 1
Else
ActiveCell.Offset(0, -1).Value = ActiveCell.Offset(-1, -1).Value + 1
End If
Unload Ajout_Accueil_Sécu
End Sub
Private Sub New_Accueil_Photo_Click()
End Sub
Private Sub UserForm_initialize()
Worksheets("Accueil_Sécu").Select
Ajout_Accueil_Sécu.New_Accueil_Date = Format(Now, "dd - mmmm - yyyy")
New_Accueil_Couleur_Badge.List = Array("Vert", "Bleu")
End Sub |
Merci de l'attention que vous porterez à ma question,
A bientôt
