Pour cumuler plusieurs macro 'worksheet_change

Le 29/08/2016 à 16:04

Bonjour à tous

malgré plusieurs soirées à plancher devant mon ordinateur sans trouver la solution je me permets de me tourner vers les experts que vous êtes pour savoir si vous pouvez m'aider.

j'ai créé une appli pour la gestion des escales de navires

dans un onglet appelé "CSR" j'ai déjà une macro qui fonctionne très bien et que voici :

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Application.Intersect(Target, Range("F14:G44")) Is Nothing Then
    Application.EnableEvents = False
    Target = UCase(Target)
    Application.EnableEvents = True
End If

If Not Application.Intersect(Target, Range("F47:G56")) Is Nothing Then
    Application.EnableEvents = False
    Target = UCase(Target)
    Application.EnableEvents = True
End If

If Not Application.Intersect(Target, Range("F59:G62")) Is Nothing Then
    Application.EnableEvents = False
    Target = UCase(Target)
    Application.EnableEvents = True
End If

If Not Application.Intersect(Target, Range("D66:G76")) Is Nothing Then
    Application.EnableEvents = False
    Target = UCase(Target)
    Application.EnableEvents = True
End If

If Not Application.Intersect(Target, Range("M14:N17")) Is Nothing Then
    Application.EnableEvents = False
    Target = UCase(Target)
    Application.EnableEvents = True
End If

If Not Application.Intersect(Target, Range("M23:N27")) Is Nothing Then
    Application.EnableEvents = False
    Target = UCase(Target)
    Application.EnableEvents = True
End If

If Not Application.Intersect(Target, Range("M35:N76")) Is Nothing Then
    Application.EnableEvents = False
    Target = UCase(Target)
    Application.EnableEvents = True
End If

End Sub

Celle-ci me permet de mettre en majuscule automatiquement les coches que j'entre. Les "x" s'écrivent donc automatiquement comme "X" même si la fonction majuscule n'est pas activée.

A cette macro je voudrai en ajouter une autre et vais essayer de vous décrire au mieux mon souhait. Dans un autre onglet appelé "Fiche Données" j'ai une zone de liste déroulante (contrôle de formulaire). Lorsque la cellule liée (L16) est sélectionnée comme 8 donc L16 = 8 cela inscrit dans l'onglet "CSR" l'appellation "NANTES + MONTOIR". Evidemment si le choix est autre cela inscrit le nom d'un autre port.

mais je souhaiterai donc que quand le choix se porte sur L16=8 dans la liste déroulante (contrôle de formulaire) cela déclenche automatiquement une autre macro (et seulement pour ce choix) que je pourrai cumuler avec la première décrite plus haut.

cela est il faisable svp ? pouvez vous m'aider ?

a noter qu'il m'est difficile d'envoyer le fichier car il fait déjà 2900 ko (je crois que cela est plus qu'autorisé sur ce site.

merci par avance

seb

Le 29/08/2016 à 16:43

Bonjour,

Pour commencer, tu peux réduire ta procédure. Un exemple ci-dessous !

Pour la suite, je crains que le forum ne puisse intervenir sans un fichier et des explications précises.

Cdlt.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim strURng As String

    strURng = "F14:G44,F47:G56,F59:G62,D66:G76,M14:N17,M23:N27,M35:N76"

    On Error GoTo err_Handler   ' par précaution

    If Not Application.Intersect(Target, Range(strURng)) Is Nothing Then
        Application.EnableEvents = False
        Target.Value = UCase(Target.Value)
        Application.EnableEvents = True
    End If

exit_Handler:
    Exit Sub

err_Handler:
    Application.EnableEvents = True
    MsgBox "Erreur : " & Err.Number & vbCrLf & Err.Description
    Resume exit_Handler

End Sub
Le 29/08/2016 à 17:21

Bonjour

merci pour le message. très sympa

du coup voici une version 'light' du fichier, si tu peux m'aider.

un grand merci par avance

seb

24test.xlsm (222.10 Ko)
Le 29/08/2016 à 21:19

Pensez vous que ce soit possible svp.

je galère...je galère

Le 30/08/2016 à 10:48

Bonjour,

Voir procédure pour la zone combinée 4.

Cdlt.

24test-3.xlsm (213.70 Ko)
Le 30/08/2016 à 14:31

Bonjour Jean Eric

mille merci pour ton dévouement et aide.

cependant j'ai du mal me faire comprendre. En effet la macro ci-dessous marche parfaitement bien :

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Application.Intersect(Target, Range("F14:G44")) Is Nothing Then

Application.EnableEvents = False

Target = UCase(Target)

Application.EnableEvents = True

End If

If Not Application.Intersect(Target, Range("F47:G56")) Is Nothing Then

Application.EnableEvents = False

Target = UCase(Target)

Application.EnableEvents = True

End If

If Not Application.Intersect(Target, Range("F59:G62")) Is Nothing Then

Application.EnableEvents = False

Target = UCase(Target)

Application.EnableEvents = True

End If

If Not Application.Intersect(Target, Range("D66:G76")) Is Nothing Then

Application.EnableEvents = False

Target = UCase(Target)

Application.EnableEvents = True

End If

If Not Application.Intersect(Target, Range("M14:N17")) Is Nothing Then

Application.EnableEvents = False

Target = UCase(Target)

Application.EnableEvents = True

End If

If Not Application.Intersect(Target, Range("M23:N27")) Is Nothing Then

Application.EnableEvents = False

Target = UCase(Target)

Application.EnableEvents = True

End If

If Not Application.Intersect(Target, Range("M35:N76")) Is Nothing Then

Application.EnableEvents = False

Target = UCase(Target)

Application.EnableEvents = True

End If

End Sub

tout comme la liste déroulante qui me donne entière satisfaction. La seule chose à laquelle je cale c'est de pouvoir ajouter une autre macro à la suite de la première macro (car je crois on ne pas cumuler 2 fois la fonction worksheet_change sauf si je me trompes)

cette deuxième macro n'exsite pas encore mais si s'agirait simplement de modifier du texte dans les lignes de l'onglet CSR.

l'évènement déclencheur est donc le fait de choisir dans ma liste déroulante le choix 'NANTES + MONTOIR'

cela te semble t il réalisable ?

merci encore

seb

ps : je joint a nouveau la version allégée de mon fichier

7test.xlsm (222.10 Ko)
Le 30/08/2016 à 14:59

Re,

A cette macro je voudrai en ajouter une autre et vais essayer de vous décrire au mieux mon souhait. Dans un autre onglet appelé "Fiche Données" j'ai une zone de liste déroulante (contrôle de formulaire). Lorsque la cellule liée (L16) est sélectionnée comme 8 donc L16 = 8 cela inscrit dans l'onglet "CSR" l'appellation "NANTES + MONTOIR". Evidemment si le choix est autre cela inscrit le nom d'un autre port.

Tu reprends mon précédent fichier.

Dans le module de feuille CSR, tu copies la ligne ci-dessous dans la procédure Worksheet_Change.

If Target.Address = "$B$9" Then MsgBox "Bonsoir " & Application.UserName, vbInformation

Cela répondait à la question posée et te montre qu'une procédure peut-être lancée au choix d'un port.

Maintenant, si je suis hors sujet, tu reformules.

Cdlt.

nota : ci-dessous la procédure de la zone combinée 4

Sub Zonecombinée4_QuandChangement()
Dim ws As Worksheet, ws2 As Worksheet
Dim x

    Set ws = Worksheets("Fiche Données")
    Set ws2 = Worksheets("CSR")

    x = VBA_Vlookup(ws.Cells(16, "L"), Range("s.ports"), 2)
    ws2.Cells(9, "B").Value = x

    Set ws2 = Nothing: Set ws = Nothing

End Sub
Le 30/08/2016 à 16:59

hello Eric

Etant novice j'ai vraiment du mal à tout comprendre

car pour moi, je crois que rien ne doit changer dans le code de ma page "fiche données" car tout marche nikel.

je crois que c'est plutôt en page 'CSR' que doivent intervenir les changements car si le port choisi indique 'NANTES + MONTOIR' dans le cellule B9 en fonction du choix de la liste déroulante de la page 'fiche données', c'est là qu'une macro nommée 'ntsmontoir' devrait se lancer.

donc si je comprends bien dans mon code déjà existant la page CSR il faudrait indiquer :

If Target.Address = "$B$9" = "NANTES + MONTOIR" Then call ntsmontoir

mais il y a bug

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$B$9" = "NANTES + MONTOIR" Then call ntsmontoir

If Not Application.Intersect(Target, Range("F14:G44")) Is Nothing Then

Application.EnableEvents = False

Target = UCase(Target)

Application.EnableEvents = True

End If

If Not Application.Intersect(Target, Range("F47:G56")) Is Nothing Then

Application.EnableEvents = False

Target = UCase(Target)

Application.EnableEvents = True

End If

If Not Application.Intersect(Target, Range("F59:G62")) Is Nothing Then

Application.EnableEvents = False

Target = UCase(Target)

Application.EnableEvents = True

End If

If Not Application.Intersect(Target, Range("D66:G76")) Is Nothing Then

Application.EnableEvents = False

Target = UCase(Target)

Application.EnableEvents = True

End If

If Not Application.Intersect(Target, Range("M14:N17")) Is Nothing Then

Application.EnableEvents = False

Target = UCase(Target)

Application.EnableEvents = True

End If

If Not Application.Intersect(Target, Range("M23:N27")) Is Nothing Then

Application.EnableEvents = False

Target = UCase(Target)

Application.EnableEvents = True

End If

If Not Application.Intersect(Target, Range("M35:N76")) Is Nothing Then

Application.EnableEvents = False

Target = UCase(Target)

Application.EnableEvents = True

End If

If Target.Address = "$B$9" = "NANTES + MONTOIR" Then MsgBox "Bonsoir " & Application.UserName, vbInformation

End Sub

je suis désolé d'abuser de ton temps à nouveau

merci

seb

Le 30/08/2016 à 17:46

Re,

Essaie ainsi :

If Target.Address = "$B$9" Then
        Select Case Target.Value
            Case "NANTES + MONTOIR"
                Call ntsmontoir
            Case "NANTES"
                '.....
            Case Else
                'ne rien faire
        End Select
    End If
Le 30/08/2016 à 18:26

Désolé mais ça ne marche pas

je mets bien le code ci-dessous dans CSR ?

En fait je n'ai pas de message d'erreur mais la macro ntsmontoir ne se lance pas... sniff

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$B$9" Then

Select Case Target.Value

Case "NANTES + MONTOIR"

Call ntsmontoir

Case "NANTES"

'.....

Case Else

'ne rien faire

End Select

End If

If Not Application.Intersect(Target, Range("F14:G44")) Is Nothing Then

Application.EnableEvents = False

Target = UCase(Target)

Application.EnableEvents = True

End If

If Not Application.Intersect(Target, Range("F47:G56")) Is Nothing Then

Application.EnableEvents = False

Target = UCase(Target)

Application.EnableEvents = True

End If

If Not Application.Intersect(Target, Range("F59:G62")) Is Nothing Then

Application.EnableEvents = False

Target = UCase(Target)

Application.EnableEvents = True

End If

If Not Application.Intersect(Target, Range("D66:G76")) Is Nothing Then

Application.EnableEvents = False

Target = UCase(Target)

Application.EnableEvents = True

End If

If Not Application.Intersect(Target, Range("M14:N17")) Is Nothing Then

Application.EnableEvents = False

Target = UCase(Target)

Application.EnableEvents = True

End If

If Not Application.Intersect(Target, Range("M23:N27")) Is Nothing Then

Application.EnableEvents = False

Target = UCase(Target)

Application.EnableEvents = True

End If

If Not Application.Intersect(Target, Range("M35:N76")) Is Nothing Then

Application.EnableEvents = False

Target = UCase(Target)

Application.EnableEvents = True

End If

End Sub

Le 31/08/2016 à 14:30

bjr

j'espère sincèrement que vous pourrez m'aider.

merci

seb

Le 31/08/2016 à 17:07

Bonjour Jean Eric

je me permets de te relancer.

crois tu que cela soit jouable ou dois je faire mon deuil ?

quoi qu'il en soit, je te remercie pour le temps passé.

seb

Le 01/09/2016 à 05:21

Bonjour,

Voir fichier avec la procédure NtsMontoir.

Cdlt.

21test-3.xlsm (215.41 Ko)
Le 01/09/2016 à 13:43

Encore un grand merci Jean Eric

j'ai essayé d'adapter tout celà à mon fichier car celui que je t'avais envoyé n'était que la version 'light'

on avance on avance...

j'ai l'impression que c'est bien partit mais j'ai juste un bug quand je lance la macro '!Zonecombinée4_QuandChangement' via le menu déroulant.

en effet j'ai un message erreur indiquant :

La méthode 'Range' de l'objet '_Global' à échoué

Quand je vais dans "débogage" apparait en surligné jaune :

x = VBA_Vlookup(ws.Cells(16, "L"), Range("s.ports"), 2)

sais tu à quoi correspon la valeur "s.ports")

merci par avance Jean Eric

Le 01/09/2016 à 13:47

Bonjour,

Cela correspond à la plage AU5:AU12 (de mémoire) qui comporte le nom des ports.

Voir gestionnaire de noms !...

Cdlt.

Le 01/09/2016 à 15:04

Ok j'essaie ce soir et te tiens informé

donc si je comprends bien je modifier :

x = VBA_Vlookup(ws.Cells(16, "L"), Range("s.ports"), 2)

en

x = VBA_Vlookup(ws.Cells(16, "L"), Range("AU5:AU12"), 2)

MERCI

Le 01/09/2016 à 15:31

Re,

Attention à la feuille active !...

Cdlt.

Le 01/09/2016 à 16:11

ah effectivement. !

comment specifier que la macro se déroule dans la fiche CSR stp ?

par exemple si je veux que la macro appeléee csrntsmontoir se lance dans la ficher 'csr'

Sub csrntsmontoir()

'

' csrntsmontoir Macro

'

'

Sheets("CSR").Select

Range("A14").Select

ActiveCell.FormulaR1C1 = "aaaaaaaa"

Range("A16").Select

ActiveCell.FormulaR1C1 = "bbbbbbbb"

Range("A18").Select

ActiveCell.FormulaR1C1 = "ccccccccc"

Range("A20").Select

ActiveCell.FormulaR1C1 = "dddddddd"

Range("E3").Select

End Sub

merci

Le 02/09/2016 à 16:40

Bonsoir Jean Eric

crois tu que cela soit réalisable ?

merci et bon WE a toi

Le 03/09/2016 à 19:56

bonjour

personne pour m'aider svp ?

suis dans le dernière ligne droite de mon projet et c'est le dernier point qui me manque.

merci par avance

seb

Rechercher des sujets similaires à "cumuler macro worksheet change"