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

A

ascal44

XLDnaute Occasionnel
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
 
Trier par date Trier par votes
Roland_M

Roland_M

XLDnaute Barbatruc
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
 
Dernière édition:
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
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é...
 
Vote positif 0 Vote négatif
A

ascal44

XLDnaute Occasionnel
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
 
Vote positif 0 Vote négatif
Roland_M

Roland_M

XLDnaute Barbatruc
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.
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

S
  • Question
Microsoft 365 créer un macro vba
Réponses
0
Affichages
201
souhaib ad
S
C
  • Question
Autres Enregistrer un code barre dans la cellule avant le titre qui est déja enregistré
Réponses
11
Affichages
559
Chatron
C
C
  • Question
Autres bug sur une procédure avec textbox contenant un code barre
2
Réponses
15
Affichages
778
TooFatBoy
TooFatBoy
U
  • Question
Autres Enregistrer sur Onglet TOTO
Réponses
2
Affichages
420
un internaute
U
Y
  • Question
XL 2013 Macro positionnée dans le code d'un feuille
Réponses
10
Affichages
334
Dranreb
Dranreb
laurent950
  • Question
XL 2016 Depuis un Module Standard pouvoir Récupérer la Photocopie d'une Classe (dont/Avec) la collection qui est incluse dans le Module de Classe.
6 7 8
Réponses
115
Affichages
4 K
laurent950
laurent950
A
  • Question
XL 2019 Vérifier si une ligne existe dans un autre fichier
Réponses
7
Affichages
528
A-F
A
G
  • Question
Microsoft 365 Incompatibilité de type - Array
Réponses
2
Affichages
288
guiyom
G
T
  • Question
Microsoft 365 Problème affichage multipage dans un tabstrip
Réponses
1
Affichages
388
troki74
T
gsx-air
  • Question
Microsoft 365 Code qui ne fonctionne pas sur Excel 365
Réponses
13
Affichages
668
Staple1600
Staple1600

Membres actuellement en ligne

24 membres et 316 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 856
Messages
2 092 860
Membres
105 544
dernier inscrit
Eden90