Code plante quand il est inséré dans un module

ascal44 · 29 Juin 2012

Bonjour ,

J'ai un code qui est utilisé dans plusieurs feuilles. Je veux le mettre dans un module pour réduire les écritures , mais j'ai l'erreur d'exécution 91 variable objet ou variable de bloc with non définie.

Ce code dans la feuille fonctionne:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

'Copier la mise en forme des N°  ( affectations)
Dim Intérieur As Integer, Couleur As Long, Référence As Integer, i As Integer, cel As Variant
Dim Taille_police As Integer, Souligné As Integer, Couleur_police As Long, Gras_ou_non As Boolean

If Target.Count > 1 Then Exit Sub 'sortir s'il y a plusieurs copie


On Error Resume Next
If Not Application.Intersect(Target, Range("C6:C26,H6:30,M6:M37,R6:R39")) Is Nothing Then


    Référence = Target
    With Sheets("PARC")
        For i = 7 To .Range("C65000").End(xlUp).Row
            If .Cells(i, 3) = Référence Then
                GoTo Etiquette
            End If
        Next
Etiquette:


    Intérieur = .Cells(i, 3).Interior.Pattern
    Couleur = .Cells(i, 3).Interior.Color
    Taille_police = .Cells(i, 3).Font.Size
    Souligné = .Cells(i, 3).Font.Underline
    Couleur_police = .Cells(i, 3).Font.Color
    Gras_ou_non = .Cells(i, 3).Font.Bold


    End With
    Target.Interior.Pattern = Intérieur
    Target.Interior.Color = Couleur
    Target.Font.Size = Taille_police
    Target.Font.Underline = Souligné
    Target.Font.Color = Couleur_police
    Target.Font.Bold = Gras_ou_non


End If

End Sub

Et celui ci dans un module qui plante :

Code:

 Sub Affectations_R_V_B_J()
'Copier la mise en forme des N°  ( affectations)
Dim Intérieur As Integer, Couleur As Long, Référence As Integer, i As Integer, cel As Variant
Dim Taille_police As Integer, Souligné As Integer, Couleur_police As Long, Gras_ou_non As Boolean
Dim Target As Range


    
 If Target.Count > 1 Then Exit Sub 'sortir s'il y a plusieurs copie


On Error Resume Next
If Not Application.Intersect(Target, Range("C6:C26,H6:30,M6:M37,R6:R39")) Is Nothing Then


    Référence = Target
    With Sheets("PARC")
        For i = 7 To .Range("C65000").End(xlUp).Row
            If .Cells(i, 3) = Référence Then
                GoTo Etiquette
            End If
        Next
Etiquette:


    Intérieur = .Cells(i, 3).Interior.Pattern
    Couleur = .Cells(i, 3).Interior.Color
    Taille_police = .Cells(i, 3).Font.Size
    Souligné = .Cells(i, 3).Font.Underline
    Couleur_police = .Cells(i, 3).Font.Color
    Gras_ou_non = .Cells(i, 3).Font.Bold


    End With
    Target.Interior.Pattern = Intérieur
    Target.Interior.Color = Couleur
    Target.Font.Size = Taille_police
    Target.Font.Underline = Souligné
    Target.Font.Color = Couleur_police
    Target.Font.Bold = Gras_ou_non


End If

End Sub

Cela éclaircirait bien mon classeur de mettre ces lignes de code dans un module

Roland_M · 29 Juin 2012

Re : Code plante quand il est inséré dans un module

bonjour,

ici il faut passer Target
et supprimer Dim Target As Range
Sub Affectations_R_V_B_J(Target As Range)

puis appel routine dans module
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then Affectations_R_V_B_J Target
End Sub

supprimer ces lignes dans Sub Affectations_R_V_B_J
Dim Target As Range
If Target.Count > 1 Then Exit Sub 'sortir s'il y a plusieurs copie

SOIT:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then Affectations_R_V_B_J Target
End Sub

'<<<<<<<<<<<<< DANS MODULE <<<<<<<<<<<<<<<<<<<<<
'Copier la mise en forme des N°  ( affectations)
Sub Affectations_R_V_B_J(Target As Range)
Dim Intérieur As Integer, Couleur As Long, Référence As Integer, i As Integer, cel As Variant
Dim Taille_police As Integer, Souligné As Integer, Couleur_police As Long, Gras_ou_non As Boolean

On Error Resume Next
If Not Application.Intersect(Target, Range("C6:C26,H6:30,M6:M37,R6:R39")) Is Nothing Then
    Référence = Target
    With Sheets("PARC")
        For i = 7 To .Range("C65000").End(xlUp).Row
            If .Cells(i, 3) = Référence Then GoTo Etiquette
        Next
Etiquette:
    Intérieur = .Cells(i, 3).Interior.Pattern
    Couleur = .Cells(i, 3).Interior.Color
    Taille_police = .Cells(i, 3).Font.Size
    Souligné = .Cells(i, 3).Font.Underline
    Couleur_police = .Cells(i, 3).Font.Color
    Gras_ou_non = .Cells(i, 3).Font.Bold

    End With
    Target.Interior.Pattern = Intérieur
    Target.Interior.Color = Couleur
    Target.Font.Size = Taille_police
    Target.Font.Underline = Souligné
    Target.Font.Color = Couleur_police
    Target.Font.Bold = Gras_ou_non
End If
End Sub

edit (salut Robert)

bien que je ne comprenne pas ceci
----------------------------------------
With Sheets("PARC")
For i = 7 To .Range("C65000").End(xlUp).Row
If .Cells(i, 3) = Référence Then GoTo Etiquette
Next
Etiquette:
----------------------------------------
ceci est suffisant:
If .Cells(i, 3) = Référence Then exit for

mais comme ton code est conçue si la condition n'est pas remplie
le code continue tout de même à la sortie du NEXT !? et là I est toujours supérieur de 1 !? risque d'erreur !

je vois plutôt comme ceci:

Code:

'<<<<<<<<<<<<< DANS MODULE <<<<<<<<<<<<<<<<<<<<<
'Copier la mise en forme des N°  ( affectations)
Sub Affectations_R_V_B_J(Target As Range)
Dim I As Long '<<<<< ici c'est long !? car boucle C65000 !?
On Error Resume Next
If Not Application.Intersect(Target, Range("C6:C26,H6:30,M6:M37,R6:R39")) Is Nothing Then
   Référence = Target
   With Sheets("PARC")
    For I = 7 To .Range("C65000").End(xlUp).Row
     If .Cells(I, 3) = Référence Then
         Target.Interior.Pattern = .Cells(I, 3).Interior.Pattern
         Target.Interior.Color = .Cells(I, 3).Interior.Color
         Target.Font.Size = .Cells(I, 3).Font.Size
         Target.Font.Underline = .Cells(I, 3).Font.Underline
         Target.Font.Color = .Cells(I, 3).Font.Color
         Target.Font.Bold = .Cells(I, 3).Font.Bold
     End If
    Next
   End With
End If
On Error GoTo 0: Err.Clear
End Sub

reste à voir si tu modif une seule cellule et quiite la boucle !?
si c'est le cas il faut rajouter ceci à la fin du test dans la boucle > Exit For
...
...
Target.Font.Bold = .Cells(I, 3).Font.Bold
Exit For ' <<<<<<<<<<<<<<<<<<<
End If
Next
End With

Robert · 29 Juin 2012

Re : Code plante quand il est inséré dans un module

Bonjour Acal, bonjour le forum,

Quand tu utilises la procédure événementielle Change, la référence est Target qui correspond à la cellule que tu viens d'éditer. Si tu transpose cela dans un module il faut remplacer cette référence Target dans le code. Par quoi ? Ben ça dépend de ton cas. Des fois c'est par une addresse en dur (Range("A1") par exemple) ou par la cellule active (ActiveCell). Sans fichier exemple difficile de t'en dire plus.

Mais si c'est juste pour réduire les écritures tu peux utiliser la procédure événementielle Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) du composant ThisWorbook. Un exemple avec ton code qui agira sur tous les onglets du classeur :

Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Copier la mise en forme des N°  ( affectations)
Dim Intérieur As Integer, Couleur As Long, Référence As Integer, i As Integer, cel As Variant
Dim Taille_police As Integer, Souligné As Integer, Couleur_police As Long, Gras_ou_non As BooleanIf Target.Count > 1 Then Exit Sub 'sortir s'il y a plusieurs copie
On Error Resume Next
If Not Application.Intersect(Target, Range("C6:C26,H6:30,M6:M37,R6:R39")) Is Nothing Then
    Référence = Target
    With Sheets("PARC")
        For i = 7 To .Range("C65000").End(xlUp).Row
            If .Cells(i, 3) = Référence Then
                GoTo Etiquette
            End If
        Next
Etiquette:
        Intérieur = .Cells(i, 3).Interior.Pattern
        Couleur = .Cells(i, 3).Interior.Color
        Taille_police = .Cells(i, 3).Font.Size
        Souligné = .Cells(i, 3).Font.Underline
        Couleur_police = .Cells(i, 3).Font.Color
        Gras_ou_non = .Cells(i, 3).Font.Bold
    End With
    Target.Interior.Pattern = Intérieur
    Target.Interior.Color = Couleur
    Target.Font.Size = Taille_police
    Target.Font.Underline = Souligné
    Target.Font.Color = Couleur_police
    Target.Font.Bold = Gras_ou_non
End If
End Sub

[Édition]
Bonjour Roland on s'est croisé...

ascal44 · 29 Juin 2012

Re : Code plante quand il est inséré dans un module

Merci Roland , ça réduit pas mal l'écriture.
Je voudrais aussi me servir du code pour l'exécuter sur une autre feuille en boucle sur les cellules de D2 à D200.
j'ai essayé cela , mais ça ne fonctionne pas...

Code:

'<<<<<<<<<<<<< DANS MODULE <<<<<<<<<<<<<<<<<<<<<
'Copier la mise en forme des N°  ( affectations)
Sub Affectations_OPTH(Target As Range)
Dim I As Long '<<<<< ici c'est long !? car boucle C65000 !?
On Error Resume Next
If Not Application.Intersect(Target, Range("D2:D200")) Is Nothing Then
   Référence = Target
   With Sheets("PARC")
    For I = 2 To .Range("D200").End(xlUp).Row
     If .Cells(I, 3) = Référence Then
         Target.Interior.Pattern = .Cells(I, 3).Interior.Pattern
         Target.Interior.Color = .Cells(I, 3).Interior.Color
         Target.Font.Size = .Cells(I, 3).Font.Size
         Target.Font.Underline = .Cells(I, 3).Font.Underline
         Target.Font.Bold = .Cells(I, 3).Font.Bold
     End If
    Next
   End With
End If
On Error GoTo 0: Err.Clear
End Sub

Legolas · 29 Juin 2012

Re : Code plante quand il est inséré dans un module

Bonjour,

Pour la colonne D, ne faut-il pas mettre cells(I,4)

A plus.

Roland_M · 29 Juin 2012

Re : Code plante quand il est inséré dans un module

re

reprendre le Sub complet du module
et corriger comme indiqué le Sub Worksheet_Change(...)

Code:

'<<<<<<<<<<< DANS LE CODE FEUILLE <<<<<<<<
'selon ta feuille tu y mets tes paramètres :
' soit Target et la Lettre de la colonne
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
   Affectations_R_V_B_J Target, "C" ' < ici la lettre de la colonne selon la feuille !?
End If
End Sub

'<<<<<<<<<<<< DANS LE MODULE <<<<<<<<<<<<<<<<<
'Copier la mise en forme des N° (affectations)
Sub Affectations_R_V_B_J(Target As Range, Col$)
Dim I As Long '<<<<< ici c'est long !? car boucle C65000 !?
On Error Resume Next
If Not Application.Intersect(Target, Range("C6:C26,H6:30,M6:M37,R6:R39")) Is Nothing Then
   Rang$ = Col$ & Trim(ActiveSheet.Rows.Count)
   Référence = Target
   With Sheets("PARC")
    For I = 7 To .Range(Rang$).End(xlUp).Row
     If .Cells(I, Col$) = Référence Then
         Target.Interior.Pattern = .Cells(I, Col$).Interior.Pattern
         Target.Interior.Color = .Cells(I, Col$).Interior.Color
         Target.Font.Size = .Cells(I, Col$).Font.Size
         Target.Font.Underline = .Cells(I, Col$).Font.Underline
         Target.Font.Color = .Cells(I, Col$).Font.Color
         Target.Font.Bold = .Cells(I, Col$).Font.Bold
     End If
    Next
   End With
End If
On Error GoTo 0: Err.Clear
End Sub

tu peux aussi dans le même principe et respect du passage des paramètres mettre:
"C6:C26,H6:30,M6:M37,R6:R39" ou autre !
mais les paramètres doit être de même type et passer dans le même ordre !?
et bien entendu dans le module remplacer les données mis en dur par ces variables.

ascal44 · 1 Juillet 2012

Re : Code plante quand il est inséré dans un module

Bonjour , je n'arrive pas à faire l'exécution du code sur les cellules de D2 à D200 !

Effectuez une recherche sur Excel Downloads...

Code plante quand il est inséré dans un module

ascal44

XLDnaute Occasionnel

Roland_M

XLDnaute Barbatruc

Robert

XLDnaute Barbatruc

ascal44

XLDnaute Occasionnel

Legolas

XLDnaute Occasionnel

Roland_M

XLDnaute Barbatruc

ascal44

XLDnaute Occasionnel

Discussions similaires

Nous accordons de l'importance à votre vie privée