Pb de cumul de macro (au niveau de la déclaration)

[Bud.boundy]

Bonjour, j'aimerais cumulé 2 macros à l'interieur d'une même feuille d'un même classeur. Ces deux macros marchent parfaitement mais dès qu'elles sont associées, cela bug puisque la déclaration semble être identique...
Quelqu'un pourraît simplement m'aider à changer la amnière de déclarer (j'y connais rien) ou l'intégrer dans un module... bref, à vous de voir ce qui est mieux pour moi...

MERCI POUR VOTRE AIDE
A BIENTOT

VOICI LA 1ERE MACRO :
Private Sub Worksheet_Change(ByVal Target As Range)
' Activé au changement de sélection de cellule seulement en colonne 1 et 2 et en dessous de la ligne 13

With ActiveCell.Validation
On Error Resume Next
If .InCellDropdown = True Then
Select Case .Formula1
Case "=SousMatière"
If WorksheetFunction.CountIf(Worksheets("Base").Range("Matière"), Target) = 1 Then
SendKeys "%{DOWN}"
End If
Case "=Solution"
If WorksheetFunction.CountIf(Worksheets("Base").Range("$J$1:$AV$8"), Target) = 0 Then
SendKeys "%{DOWN}"
End If
End Select
End If
End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Activé au changement de sélection de cellule seulement en colonne 1 et 2 et en dessous de la ligne 13
With ActiveCell.Validation
On Error Resume Next
If .InCellDropdown = True Then
Select Case .Formula1
Case "=SousMatière"
If WorksheetFunction.CountIf(Worksheets("Base").Range("Matière"), Target) = 0 Then
SendKeys "%{DOWN}"
End If
Case "=Solution"
If WorksheetFunction.CountIf(Worksheets("Base").Range("$J$1:$AV$8"), Target) = 0 Then
SendKeys "%{DOWN}"
End If
End Select
End If
End With
End Sub


VOICI LA 2EME MACRO :
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Val As String
Dim MyCell As Range
Dim MyPicture As Picture
Dim Pict
Dim a As Long
On Error GoTo errorhandler
Application.ScreenUpdating = False

Val = Target.Value

With Application.FileSearch
.NewSearch
.Filename = ".jpg"
.LookIn = ThisWorkbook.Path
.SearchSubFolders = False
.Execute msoSortByFileName, msoSortOrderAscending

If .Execute > 0 Then
Set MyCell = Target.Offset(1, 0)
MyCell.Select



For Each Pict In ActiveSheet.DrawingObjects ' supprimer ancienne image dans cellule
If Pict.Left = MyCell.Left + (MyCell.Width - 50) / 2 And Pict.Top = MyCell.Top + (MyCell.Height - 50) / 2 Then Pict.Delete
Next

Set MyPicture = ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Val & ".jpg")
With MyPicture.ShapeRange
.LockAspectRatio = msoFalse
.Height = 55
.Width = 55
.Top = MyCell.Top + (MyCell.Height - 50) / 2
.Left = MyCell.Left + (MyCell.Width - 50) / 2

End With
MyCell.Select
MsgBox Pict.Left
End If


End With
Application.ScreenUpdating = True
Exit Sub

errorhandler:
Application.ScreenUpdating = True
Exit Sub
End Sub

 

[Jacques87]

Re : Pb de cumul de macro (au niveau de la déclaration)

Bonsoir,

Tu appelles tes macros à chaque changement opéré dans la feuille (Private Worksheet_change). Il est donc normal qu'elles soient activées simultanément.

Un conseil : donne leur un nom, range les dans un module et appelle les si nécessaire. (Call macro1 et Call macro2 sont deux lignes de code à insérer dans ton code afin d'appeler la macro1 et la macro2).

Bon courage

 

[Bud.boundy]

Re : Pb de cumul de macro (au niveau de la déclaration)

Bonsoir,

Le problème est que je n'y connais rien... Comment dois-je faire ??

Merci

Bonsoir,

Tu appelles tes macros à chaque changement opéré dans la feuille (Private Worksheet_change). Il est donc normal qu'elles soient activées simultanément.

Un conseil : donne leur un nom, range les dans un module et appelle les si nécessaire. (Call macro1 et Call macro2 sont deux lignes de code à insérer dans ton code afin d'appeler la macro1 et la macro2).

Bon courage

 

[porcinet82]

Re : Pb de cumul de macro (au niveau de la déclaration)

Bonsoir Bud.boundy, Jacques,

Je passe sur le fil essentiellement pour saluer mon ami Jacques que je n'es pas encore eu le plaisir de croiser sur un fil depuis son retour.
Sinon concernant tes macro, je te propose soit de les regrouper, ce qui donnerai quelque chose de ce genre :

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Val As String
Dim MyCell As Range
Dim MyPicture As Picture
Dim Pict
Dim a As Long
On Error GoTo errorhandler
Application.ScreenUpdating = False
With ActiveCell.Validation
    On Error Resume Next
    If .InCellDropdown = True Then
        Select Case .Formula1
        Case "=SousMatière"
            If WorksheetFunction.CountIf(Worksheets("Base").Range("Matière"), Target) = 1 Then
                SendKeys "%{DOWN}"
            End If
        Case "=Solution"
            If WorksheetFunction.CountIf(Worksheets("Base").Range("$J$1:$AV$8"), Target) = 0 Then
                SendKeys "%{DOWN}"
            End If
        End Select
    End If
End With
Val = Target.Value
With Application.FileSearch
    .NewSearch
    .Filename = ".jpg"
    .LookIn = ThisWorkbook.Path
    .SearchSubFolders = False
    .Execute msoSortByFileName, msoSortOrderAscending
    
    If .Execute > 0 Then
        Set MyCell = Target.Offset(1, 0)
        MyCell.Select
        For Each Pict In ActiveSheet.DrawingObjects ' supprimer ancienne image dans cellule
            If Pict.Left = MyCell.Left + (MyCell.Width - 50) / 2 And Pict.Top = MyCell.Top + (MyCell.Height - 50) / 2 Then Pict.Delete
        Next
        Set MyPicture = ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Val & ".jpg")
        With MyPicture.ShapeRange
            .LockAspectRatio = msoFalse
            .Height = 55
            .Width = 55
            .Top = MyCell.Top + (MyCell.Height - 50) / 2
            .Left = MyCell.Left + (MyCell.Width - 50) / 2
        End With
        MyCell.Select
        MsgBox Pict.Left
    End If
End With
Application.ScreenUpdating = True
Exit Sub
errorhandler:
Application.ScreenUpdating = True
End Sub

Autre solution comme te l'as proposé Jacques, faire appel au macro que tu aurais placé dans un module standard. Je t'ai mis l'exemple en pièces jointes.

Sinon je ne comprends pas tres bien ta phrase en commentaire dans la 1ere macro 'Activé au changement de sélection de cellule seulement en colonne 1 et 2 et en dessous de la ligne 13 je ne vois pas ou tu dis dans le code de déclencher seulement la macro en colonne A et B et en dessous de la ligne 13, il faudrait rajouter une ligne de code du style suivant non?
If Not Intersect(Target, Range("A14:B65536")) Is Nothing Then

@+

 

[Bud.boundy]

Re : Pb de cumul de macro (au niveau de la déclaration)

Bonjour,

puis-je avoir un exemple de fichier joint où mes macros Call macro1 et Call macro2 sont rangés dans 2 modules différents...

Merci pour tout votre travail...

Bon courage
et bonne journée

Bud

 

[porcinet82]

Re : Pb de cumul de macro (au niveau de la déclaration)

Salut,

As-tu regardé le fichier joint que je t'ai mis dans mon dernier post? Parce que dedans, les macro Macro1 et Macro2 sont dans un module de feuille alors que la macro qui les appelles est dans un module de feuille.

Tu n'as pas besoin de mettre les Macro1 et Macro2 dans 2 modules séparés, le résultat sera identique a celui du fichier en pièce jointe.

@+

 

[Bud.boundy]

Re : Pb de cumul de macro (au niveau de la déclaration)

Cher Porcinet,

Je n'y arrive décidement pas alors je fais appel à vos services s'il vous plaît...
J'aimerais s'il vous plaît que vous puissiez m'aider à cumuler la fonction calendar (FEUILLE CALENDAR) en A1 de la feuille PROGRAMME puis la macro de la feuille CHIFFRE 1 à 80 dans les cellules A3:A100 de cette même feuille PROGRAMME...

A ce sujet, il me faudrait aussi d'ailleurs continuer d'améliorer la macro existante de la feuille PROGRAMME (liste déroulante à plusieurs conditions) puisque j'aimerais que les étapes intermdiaires de mon choix effectué en colonne B s'affichent en colonne C, D et E comme indiqué dans l'exemple...

Je sais que ma demande est grande mais je suis sincèrement incapable de modifier la déclaration des macros...

Merci de m'aider

 

[porcinet82]

Re : Pb de cumul de macro (au niveau de la déclaration)

re,

Je ne sais pas si c'est la fatigue de la fin de journée ou la déprime du temps pourrave qu'il fait en ce moment, mais je ne comprends pas du tout ce que tu veux faire. Il faudrait que tu donne plus d'informations, plus claires et plus précise afin que je puisse t'aider.

De plus, dans ton fichier joint, il manque les USF donc ca pose problème dans la compréhension des codes. Dernière chose, évite le vous, ici nous sommes une grande famille

@+

 

[Mytå]

Re : Pb de cumul de macro (au niveau de la déclaration)

Salut le Forum

Pour le userform regarde donc tes anciens posts Bud.boundy , tu as un
fichier joint avec un module de classe pour gérer ton Userform

https://www.excel-downloads.com/threads/creation-dun-userform-avec-chiffre-de-1-a-100.65823/

Mytå

 

[Bud.boundy]

Re : Pb de cumul de macro (au niveau de la déclaration)

Bonjour le forum,

Voici le fichier joint contenant le userform (chiffre 1 à 80) que j'aimerais mettre en place dans les cases jaunes de la feuille PROGRAMME...

Ensuite, vous trouverez la macro calendar que j'aimerais elle-aussi appliqué uniquement dans la cellule A1 de la feuille PROGRAMME...

Enfin dernière demande, il y actuellement une macro qui marche parfaitement dans la feuille programme... Cette macro me permet d'avoir un menu déroulant à plusieurs conditions... J'aimerais simplement que cette macro reste active mais que les étapes intermédiares de mes choix effectué en colonne B s'affichent dans les cellules de la colonne C, D et E... comme dans l'exemple indiqué...

Merci pour votre précieuse collaboration... Ce projet me tient vraiment à coeur, si quelqu'un pouvait m'apporter un petit coup de pouce, ça serait formidable...

Merci et bonne journée

 

[Bud.boundy]

Re : Pb de cumul de macro (au niveau de la déclaration)

Bonjour à tous,

Je me demandais simplement si mon message comme ma pièce jointe avait été correctement comprise... Peut-être me faut-il encore expliquer davantage ce que je souhaite...

Merci de m'aider

Bonne journée

 

[Bud.boundy]

Re : Pb de cumul de macro (au niveau de la déclaration)

bonjour,

Un petit coup de pouce m'aiderait tellement à avancer

Merci Merci Merci