Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Userform sur macro evenementielle

10 réponses
Avatar
JP
Bonjour,

J'ai une macro qui d=E9bute comme suis:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D1")) Is Nothing Then

Est-ce qu il est possible de faire ouvrir un userform au demarrage de ce ty=
pe de macro?
Le but etant d eviter un effacement de donnees.

Merci pour le conseil

JP

10 réponses

Avatar
MichD
Bonjour,

Je n'ai pas compris ce que tu veux faire?

En quoi l'ouverture d'un formulaire (userform)
empêche-t-elle de supprimer des données?

Dans ta procédure événementielle, si tu veux ouvrir un formulaire,

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D1")) Is Nothing Then
Userform1.Show
End if
End Sub


MichD
---------------------------------------------------------------
Avatar
JP
Bonjour MichD,

C'est ce que j'ai fait "userform1.show" mais j ai un message d erreur 404 et le debogage s arrete sur "userform1.show.

Dans la macro, les instructions suivantes effacent des donnees, c est pourquoi je veux demander une confirmation avec un userform.

Les instructions qui suivent sont:
'Efface les plages de la grille
Union(Range("G10:Z50"), Range("F11:F50"), Range("A12:D31")).Select
Selection.ClearContents

Merci de ton aide

JP
Avatar
JP
Lire Erreur 424 au lieu de 404! Désolé

JP
Avatar
MichD
En supposant que ton formulaire porte réellement
le nom de Userform1, voici la macro

Dans la procédure, si tu utilises cette ligne de code :
UserForm1.Show
L'exécution de la procédure s'arrête jusqu'au moment
où le formulaire se fermera puisque le formulaire est ouvert
dans une fenêtre modale.

Si tu désires que tout le code s'exécute dès l'ouverture du
formulaire, utilise ce code : UserForm1.Show 0
le 0 permet d'ouvrir le formulaire dans une fenêtre non modale.
Même si le formulaire est ouvert, la feuille de calcul dernière est
toujours accessible.

'-----------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D1")) Is Nothing Then
UserForm1.Show
Application.EnableEvents = False
Union(Range("G10:Z50"), Range("F11:F50"),
Range("A12:D31")).ClearContents
Application.EnableEvents = True
End If
End Sub
'-----------------------------------------



MichD
---------------------------------------------------------------
Avatar
JP
MichD,
Effectivement! Seul tout fonctionne!

Voici la macro complète à recopier dans une feuille pour voir si tu dia gnostiques l'erreur!

Merci encore

JP

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D1")) Is Nothing Then
'userform1.show
'Appel la macro Déprotège les feuilles
' DeprotegeFeuilles
'-------------------------------------------------------------------------- -----------------------
'Déclaration des variables
Dim x1 As Byte, x2 As Byte
Dim Nbmatches As String, Nbterrain As String, Nbequipe As String, Eqp As St ring, origine As String
Dim T As Byte, m As Byte, ligne As Byte, col As Variant
'-------------------------------------------------------------------------- -----------------------
'Efface les plages de la grille
Union(Range("G10:Z50"), Range("F11:F50"), Range("A12:D31")).Select
Selection.ClearContents
Selection.Borders.LineStyle = xlNone
Range("F10").Select
' ------------------------------------------------------------------------- ------------------
' Valeur de décalage de la grille par rapport à A1
x1 = 5: x2 = 6
'Variable Nbterrain = D1 et tracer de la ligne 10 terrains et scores
Nbterrain = Range("D1")
For T = 1 To Nbterrain
Cells(10, T * 2 + x1) = "Ter " & T
Cells(10, T * 2 + x2) = "Score"
Next T
'Tracé grille nb matches
' Variable Nbmatches = D3
Nbmatches = Range("D3")
For m = 1 To Nbmatches
Cells(m * 2 + 9, 6) = "N°" & m
Cells(m * 2 + 9, 7) = "1"
Cells(m * 2 + 10, 6) = "----"
Next m
'-------------------------------------------------------------------------- ------------------
'Tracé des équipes par lignes et colonnes
'
Nbequipe = Range("D2"): Eqp = 2: origine = 2
'
For ligne = 1 To Nbmatches * 2
'Tracé des equipe vers la droite
For col = 1 To Nbterrain * 2
If col = Nbterrain Then ligne = ligne + 1: Cells(li gne + 10, col * 2 + 5).Select: Exit For
If Eqp > Nbequipe Then Eqp = 2
Cells(ligne + 10, col * 2 + 7) = Eqp
Eqp = Eqp + 1
Next col
' Tracé des équipes vers la gauche
For col = ActiveCell.Column To 2 Step -2
If Eqp - 1 = Nbequipe Then Eqp = 2
If col < 6 Then: Exit For
Cells(ligne + 10, col) = Eqp
Eqp = Eqp + 1
Next col
origine = origine + 1: Eqp = origine
Next ligne
'ProtegeFeuilles
End If

End Sub
Avatar
MichD
A ) Je ne sais pas ce que la macro est censée faire
B ) Tu as des variables dans la procédure dont je ne
connais pas la valeur de départ...

Une façon simple de trouver la ligne de code qui pose problème:
Tu insères un point d'arrêt dans la procédure et tu exécutes le
code pas à pas en utilisant la touche F8.

Pour insérer le point d'arrêt, tu peux cliquer sur le contour de la fenêtre
de ton code vis-à-vis une ligne de code (non une déclaration de variables)
OU tu peux insérer dès le début de ton code une nouvelle ligne avec
L'expression : Stop
La macro s'arrête à cette expression et tu utilises la touche F8
Lorsque tu auras identifié la ligne de code, tu peux la publier ici
et on verra à trouver une solution.




MichD
---------------------------------------------------------------
"JP" a écrit dans le message de groupe de discussion :


MichD,
Effectivement! Seul tout fonctionne!

Voici la macro complète à recopier dans une feuille pour voir si tu
diagnostiques l'erreur!

Merci encore

JP

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D1")) Is Nothing Then
'userform1.show
'Appel la macro Déprotège les feuilles
' DeprotegeFeuilles
'-------------------------------------------------------------------------------------------------
'Déclaration des variables
Dim x1 As Byte, x2 As Byte
Dim Nbmatches As String, Nbterrain As String, Nbequipe As String, Eqp As
String, origine As String
Dim T As Byte, m As Byte, ligne As Byte, col As Variant
'-------------------------------------------------------------------------------------------------
'Efface les plages de la grille
Union(Range("G10:Z50"), Range("F11:F50"), Range("A12:D31")).Select
Selection.ClearContents
Selection.Borders.LineStyle = xlNone
Range("F10").Select
' -------------------------------------------------------------------------------------------
' Valeur de décalage de la grille par rapport à A1
x1 = 5: x2 = 6
'Variable Nbterrain = D1 et tracer de la ligne 10 terrains et scores
Nbterrain = Range("D1")
For T = 1 To Nbterrain
Cells(10, T * 2 + x1) = "Ter " & T
Cells(10, T * 2 + x2) = "Score"
Next T
'Tracé grille nb matches
' Variable Nbmatches = D3
Nbmatches = Range("D3")
For m = 1 To Nbmatches
Cells(m * 2 + 9, 6) = "N°" & m
Cells(m * 2 + 9, 7) = "1"
Cells(m * 2 + 10, 6) = "----"
Next m
'--------------------------------------------------------------------------------------------
'Tracé des équipes par lignes et colonnes
'
Nbequipe = Range("D2"): Eqp = 2: origine = 2
'
For ligne = 1 To Nbmatches * 2
'Tracé des equipe vers la droite
For col = 1 To Nbterrain * 2
If col = Nbterrain Then ligne = ligne + 1: Cells(ligne +
10, col * 2 + 5).Select: Exit For
If Eqp > Nbequipe Then Eqp = 2
Cells(ligne + 10, col * 2 + 7) = Eqp
Eqp = Eqp + 1
Next col
' Tracé des équipes vers la gauche
For col = ActiveCell.Column To 2 Step -2
If Eqp - 1 = Nbequipe Then Eqp = 2
If col < 6 Then: Exit For
Cells(ligne + 10, col) = Eqp
Eqp = Eqp + 1
Next col
origine = origine + 1: Eqp = origine
Next ligne
'ProtegeFeuilles
End If

End Sub
Avatar
h2so4
Bonjour,

n'est-il pas suffisant de poser une question via msgbox de la manière
suivante ?

Sub test()
a = MsgBox("etes-vous sur de vouloir supprimer les données", vbYesNo)
If a = vbYes Then
'supprimer les données
Else
'ne pas supprimer les données
End If
End Sub



JP brought next idea :
Bonjour MichD,

C'est ce que j'ai fait "userform1.show" mais j ai un message d erreur 404 et
le debogage s arrete sur "userform1.show.

Dans la macro, les instructions suivantes effacent des donnees, c est
pourquoi je veux demander une confirmation avec un userform.

Les instructions qui suivent sont:
'Efface les plages de la grille
Union(Range("G10:Z50"), Range("F11:F50"), Range("A12:D31")).Select
Selection.ClearContents

Merci de ton aide

JP
Avatar
JP
Bonjour h2so4,

Tu as raison, c'est ce que je vais faire en attendant de comprendre pourquo i mon userform ne demarre pas.

Merci à vous deux

JP
Avatar
MichD
| pourquoi mon userform ne demarre pas.

Ça c'est une autre question facile à solutionner...

Après la ligne de code Userform1.Show 0
insère cette ligne Userform1.Repaint

Comme tu as beaucoup de ligne de code à exécuter
après l'ouverture du formulaire, tu dois forcer le
rafraîchissement de ce dernier pour qu'il apparaisse
immédiatement après avoir exécuté la ligne de code
sinon le formulaire s'affiche à la fin de l'opération...

MichD
---------------------------------------------------------------
Avatar
JP
Merci MichD, j'ai solutionné avec la proposition de h2so4.