Executer plusieurs macros dans un module

Version imprimable

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:

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:

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 ! :P

28/11/2012, 10h58
AbsolutAlex
Salut rapanui_1,

Il faut faire ça :
Code:

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:

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

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:

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:

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

28/11/2012, 11h56
Kimy_Ire
Code:

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:

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 :

Citation:

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

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

Code:

Shapes("MonImage").Delete

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

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
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.

28/11/2012, 12h33
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.
28/11/2012, 14h18
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.