Discussion :

[rapanui_1]

Bonjour,

C'est mon premier post et j'espère que je vais trouver une âme charitable pour m'aider

Voilà le problème : Je souhaite exécuter deux macros dans un module. La première affiche une image du répertoire mariage dans une cellule. La deuxième affiche également une image mais du répertoire anniversaire dans une autre cellule.

Le code de la première macro fonctionne nickel mais je n'arrive pas à exécuter la deuxième. Mes photos de mariage s'affichent mais pas les anniversaires

Je pense qu'il faut que j'utilise la fonction call mais je suis perdue.

Mon code est le suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$L$6" And Target.Count = 1 Then
    On Error Resume Next
    Shapes("MonImage").Delete
    répertoirePhoto = "L:\2012\1_Photos_Mariage"    ' adapter
    nf = répertoirePhoto & "\" & Target & ".jpg"
    If Dir(nf) <> "" Then
      Set c = Range("G6").MergeArea
      Set img = ActiveSheet.Pictures.Insert(nf)
      img.Name = "MonImage"
      img.Left = [G6].Left
      img.Top = [G6].Top
      Shapes("monimage").Height = c.Height ' On impose la hauteur
      Shapes("monimage").Width = c.Width   ' On impose la largeur
     End If
  End If
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub Worksheet_Change1(ByVal Target As Range)
  If Target.Address = "$L$16" And Target.Count = 1 Then
    On Error Resume Next
    Shapes("MonImage").Delete
    répertoirePhoto = "L:\2012\1_Photos_Anniversaire"    ' adapter
    nf = répertoirePhoto & "\" & Target & ".jpg"
    If Dir(nf) <> "" Then
      Set c = Range("G16").MergeArea
      Set img = ActiveSheet.Pictures.Insert(nf)
      img.Name = "MonImage"
      img.Left = [G16].Left
      img.Top = [G16].Top
      Shapes("monimage").Width = c.Width   ' On impose la largeur
      Shapes("monimage").Height = c.Height ' On impose la hauteur
      Shapes("monimage").LockAspectRatio = msoFalse
     End If
  End If
End Sub

Par avance je vous remercie !

[AbsolutAlex]

Salut rapanui_1,

Il faut faire ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub macro1()
.
.
.
Call macro2()
End sub
 
Sub macro2()
.
.
.
End sub

Mais je ne sais pas si ça va marcher avec le private. Et si tu donnes des noms plus explicites à tes macros ça sera plus facile aussi

Du coup ça donnerait :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Sub Photos_Mariage(ByVal Target As Range)
.
.
.
Call Photos_Anniversaire(Target)
End Sub
 
Sub Photos_Anniversaire(ByVal Target As Range)
.
.
.
End Sub

[rapanui_1]

J'ai un résultat en gardant "Worksheet_Change" pour la première macro. Par contre, j'ai renommé la deuxième "Photos_Anniversaire".

Ceci dit, j'ai un autre problème.

J'ai créé des listes déroulantes faisant appel aux photos. Pour mariage : M1, M2, M3... et pareillement pour anniversaire : A1, A2, A3...

Lorsque je lance ma liste déroulante et que j'affiche la photo de mariage M1, c'est bon.
Lorsque je fais la même opération pour les anniversaires, c'est bon aussi.

Le soucis, c'est que lorsque j'en affiche une, l'autre disparaît...


Mon code modifié est le suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$L$6" And Target.Count = 1 Then
On Error Resume Next
Shapes("MonImage").Delete
répertoirePhoto = "L:\2012\1_Photos_Mariage" ' adapter
nf = répertoirePhoto & "\" & Target & ".jpg"
If Dir(nf) <> "" Then
Set c = Range("G6").MergeArea
Set img = ActiveSheet.Pictures.Insert(nf)
img.Name = "MonImage"
img.Left = [G6].Left
img.Top = [G6].Top
Shapes("monimage").Height = c.Height ' On impose la hauteur
Shapes("monimage").Width = c.Width ' On impose la largeur
End If
End If
Call Photos_Anniversaire(Target)
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Photos_Anniversaire(ByVal Target As Range)
If Target.Address = "$L$16" And Target.Count = 1 Then
On Error Resume Next
Shapes("MonImage").Delete
répertoirePhoto = "L:\2012\1_Photos_Anniversaire" ' adapter
nf = répertoirePhoto & "\" & Target & ".jpg"
If Dir(nf) <> "" Then
Set c = Range("G16").MergeArea
Set img = ActiveSheet.Pictures.Insert(nf)
img.Name = "MonImage"
img.Left = [G16].Left
img.Top = [G16].Top
Shapes("monimage").Width = c.Width ' On impose la largeur
Shapes("monimage").Height = c.Height ' On impose la hauteur
Shapes("monimage").LockAspectRatio = msoFalse
End If
End If
End Sub

Je m'arrache les cheveux lol

[Kimy_Ire]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Shapes("monimage").Width = c.Width ' On impose la largeur
Shapes("monimage").Height = c.Height ' On impose la hauteur
Shapes("monimage").LockAspectRatio = msoFalse

Je ne sais pas du tout si cela a un impact ou pas mais la seule ligne qui change sur tes deux codes est celle en rouge.
LockAspectRatio permet à l'image d'être redimentionné indépendamment en hauteur et largeur. J'imagine qu'il faut mettre cela avant le redimentionnement :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Shapes("monimage").LockAspectRatio = msoFalse
Shapes("monimage").Width = c.Width ' On impose la largeur
Shapes("monimage").Height = c.Height ' On impose la hauteur

De plus as-tu déjà essayer de commenter cette ligne pour voir si ta deuxième macro fonctionne ?

Juste supposition.

EDIT : que veux-tu dire par :

Le soucis, c'est que lorsque j'en affiche une, l'autre disparaît...

[AbsolutAlex]

C'est normal que l'image du mariage soit supprimé, c'est ce que tu demandes au début de la macro 2

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Shapes("MonImage").Delete

Il faudrait peut être changer le "MonImage" par exemple avec "ImageMariage" et "ImageAnnif" ce qui donnerait :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$L$6" And Target.Count = 1 Then
On Error Resume Next
Shapes("MonImageMariage").Delete
répertoirePhoto = "L:\2012\1_Photos_Mariage" ' adapter
nf = répertoirePhoto & "\" & Target & ".jpg"
If Dir(nf) <> "" Then
Set c = Range("G6").MergeArea
Set img = ActiveSheet.Pictures.Insert(nf)
img.Name = "MonImageMariage"
img.Left = [G6].Left
img.Top = [G6].Top
Shapes("MonImageMariage").Height = c.Height ' On impose la hauteur
Shapes("MonImageMariage").Width = c.Width ' On impose la largeur
End If
End If
Call Photos_Anniversaire(Target)
End Sub
 
Private Photos_Anniversaire(ByVal Target As Range)
If Target.Address = "$L$16" And Target.Count = 1 Then
On Error Resume Next
Shapes("MonImageAnnif").Delete
répertoirePhoto = "L:\2012\1_Photos_Anniversaire" ' adapter
nf = répertoirePhoto & "\" & Target & ".jpg"
If Dir(nf) <> "" Then
Set c = Range("G16").MergeArea
Set img = ActiveSheet.Pictures.Insert(nf)
img.Name = "MonImageAnnif"
img.Left = [G16].Left
img.Top = [G16].Top
Shapes("MonImageAnnif").Width = c.Width ' On impose la largeur
Shapes("MonImageAnnif").Height = c.Height ' On impose la hauteur
Shapes("MonImageAnnif").LockAspectRatio = msoFalse
End If
End If
End Sub

Avec ce code tu devrais pouvoir afficher, une image mariage et une image anniversaire.

[rapanui_1]

Je te remercie pour ce repositionnement de ligne. Certaines de mes images ne se calibraient pas à la cellule...

Je n'ai pas commenté la ligne. A vrai dire, je débute en VBA et ne connais pas la procédure.

"Le soucis, c'est que lorsque j'en affiche une, l'autre disparaît... "

Lorsque j'affiche mon image Mariage, c'est parfait. Par contre, lorsque je souhaite afficher l'image Anniversaire, l'image Mariage disparaît.
Mon objectif, c'est que ces deux images apparaissent.

[rapanui_1]

Abslutalex, je n'ai pas vu ton post.

Tout fonctionne, c'est parfait.

Je tenais à vous remercier grandement pour votre aide.

J'espère pouvoir aider des internautes un jour comme vous l'avez fait pour moi.

Bien à vous.