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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichD
Le #25428062
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
---------------------------------------------------------------
JP
Le #25428082
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
JP
Le #25428072
Lire Erreur 424 au lieu de 404! Désolé

JP
MichD
Le #25428122
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
---------------------------------------------------------------
JP
Le #25428112
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
MichD
Le #25428152
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
h2so4
Le #25428182
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
JP
Le #25428432
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
MichD
Le #25428802
| 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
---------------------------------------------------------------
JP
Le #25432222
Merci MichD, j'ai solutionné avec la proposition de h2so4.
Publicité
Poster une réponse
Anonyme