Userform sur macro evenementielle
Le
JP
Bonjour,
J'ai une macro qui débute 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
J'ai une macro qui débute 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
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
---------------------------------------------------------------
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
JP
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
---------------------------------------------------------------
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
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
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 :
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
Ç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
---------------------------------------------------------------