Empêcher fermeture UserForm

Le 17/07/2014 à 11:44

Bonjour le forum,

J'aimerai savoir si il est possible de conserver une UserForme non nodal ouverte malgré l’exécution d'autre macro.

En effet je fais apparaître une UserForme non nodal sur laquelle est affiché des informations et qui possèdent un bouton associé à une macro.

En parallèle de cette UserForme je souhaite utiliser des macro pour remplir des informations de manières automatique.

Le problème est que lorsque je lance ma macro pour récupérer des informations le "End Sub" me fait disparaître ma UserForme alors que je ne veux qu'elle ne soit enlever que dans le cas ou l'utilisateur clique sur le bouton de la UserForme.

Voila toutes les idées sont les bienvenues.

Merci d'avance

Le 17/07/2014 à 11:59

Tu peux joindre ton fichier ?

Cdlt

Le 17/07/2014 à 12:01

Je peux en faire un faux car le mien contient des données confidentiel.

EDIT: Evidement dans mon fichier test y pas le problème.

Le 17/07/2014 à 12:12

tu n'as pas un unload qui traine ?

Le 17/07/2014 à 12:17

Non. J'ai mis un arret de code sur mes Unload même si ils ne sont pas du tout au même endroit et le code se déroule normalement sans en rencontré.

En plus j'ai mis une message box sur la dernière ligne de la macro d'ajout de donnée et à ce moment la je vois encore la UserForme donc tres bizarre c'est vraiment le End Sub qui la ferme.

Le 17/07/2014 à 12:19

Puisque ton classeur est confidentiel colle ton code on verra peut-être le problème ... ou pas (:

Cdlt

Le 17/07/2014 à 12:24

Bonjour,

tu es sûr qu'il est fermé ?

Si tu es dans la fenêtre vbe et que tu cliques sur la fenêtre excel tu peux ne pas le voir. Et par contre le voir si tu actives ta fenêtre à partir de la barre de tâche.

eric

Le 17/07/2014 à 12:32

Je peux coller le code en elevant les noms à la limite:

Alors le code d'appel de la Usf:

Private Sub CommandButton2_Click()
Feuil3.Unprotect "1234"
Sheets("intervenants").Unprotect "1234"
Feuil20.Unprotect "1234"
Feuil20.CommandButton3.visible = False
Feuil20.Protect "1234", True, True, True
Application.EnableEvents = False
If Feuil3.Range("B9") = "" Then
Application.EnableEvents = False

Transfert.Show vbModeless
Else
MsgBox "Feuille de contre rendus déjà commencé, vous ne pouvez transférer un mission dedans"
End If
'Application.EnableEvents = True
End Sub

Code de la macro d'ajout de donnée

Private Sub CommandButton2_Click() 'Validation et envoie
Feuil20.Unprotect "1234"

Dim i As Integer
Dim a As String
Dim k As Integer
Dim verif As Boolean
verif = False
Dim mail As String
Dim LCel As Integer, CodeAscii As Integer 'longueur adresse mail/ code ascii du cara
Dim NCara As Integer 'indice de caractere adresse mail

Application.ScreenUpdating = False

i = 9
n = 21

    While (Sheets("intervenants").Cells(n, 2).Value <> "") 'On recherhce la prochaine ligne à remplir
    n = n + 1
    Wend

j = n + 1
If Feuil20.Range("D22") <> "" And Feuil20.Range("F22") <> "" Then 'verification d'existance de date

    If DateValue(Feuil20.Range("D22").Value) > DateValue(Feuil20.Range("F22").Value) Then 'vérification de la cohérence des dates
    MsgBox "La date de fin est inférieure à la date de début"
    Exit Sub
    End If
Else
MsgBox "Veuillez saisir une date de début et de fin"
Exit Sub
End If

If Feuil20.Range("C12") = "" And Feuil20.Range("C13") <> "" Then 'verification intervenants
    MsgBox "Veuillez saisir un premiere intervenant avant le second"
    Exit Sub
End If

  Feuil20.Unprotect "1234"
Sheets("intervenants").Unprotect "1234"

  mail = Feuil20.Range("G12")

  LCel = Len(Feuil20.Range("G12").Value)
  For NCara = 1 To LCel
        CodeAscii = AscW(Mid(Feuil20.Range("G12").Value, NCara))
            Select Case CodeAscii
                Case 97 To 122    ' Caracteres minuscule
               Case 65 To 90    'Caracteres majuscule
               Case 95          'caractères tiret bas
               Case 45 To 46    'caractères - et .
               Case 48 To 57    'nombre de 0 à 9
               Case 64         'arobase
           Case Else
                MsgBox "Veuillez saisir des adresses mails valide"
                Exit Sub
            End Select
   Next

   LCel = Len(Feuil20.Range("G13").Value)
  For NCara = 1 To LCel
        CodeAscii = AscW(Mid(Feuil20.Range("G13").Value, NCara))
            Select Case CodeAscii
                Case 97 To 122    ' Caracteres minuscule
               Case 65 To 90    'Caracteres majuscule
               Case 95          'caractères tiret bas
               Case 45 To 46    'caractères - et .
               Case 48 To 57    'nombre de 0 à 9
                Case 64         'arobase
           Case Else
                MsgBox "Veuillez saisir des adresses mails valide"
                Exit Sub
            End Select
 Next

 LCel = Len(Feuil20.Range("C7").Value)
   For NCara = 1 To LCel
        CodeAscii = AscW(Mid(Feuil20.Range("C7").Value, NCara))
            Select Case CodeAscii
            '\/<>:*?|
                Case 47
               MsgBox "Veuillez saisir un nom d'entreprise valide"
                Exit Sub
               Case 92
               MsgBox "Veuillez saisir un nom d'entreprise valide"
                Exit Sub
               Case 58
               MsgBox "Veuillez saisir un nom d'entreprise valide"
                Exit Sub
               Case 60
               MsgBox "Veuillez saisir un nom d'entreprise valide"
                Exit Sub
               Case 62
               MsgBox "Veuillez saisir un nom d'entreprise valide"
                Exit Sub
                Case 63
                MsgBox "Veuillez saisir un nom d'entreprise valide"
                Exit Sub
                Case 42
                MsgBox "Veuillez saisir un nom d'entreprise valide"
                Exit Sub
                Case 166
                MsgBox "Veuillez saisir un nom d'entreprise valide"
                Exit Sub
            End Select
   Next

 'nom du responsable 1
Sheets("intervenants").Cells(n, 5).Value = Feuil20.Cells(12, 3).Value

'nom du responsable 2
Sheets("intervenants").Cells(j, 5).Value = Feuil20.Cells(13, 3).Value

'nom de l'entreprise
Sheets("intervenants").Cells(n, 2).Value = Feuil20.Cells(7, 3).Value

'Adresse
Sheets("intervenants").Cells(n, 11).Value = Feuil20.Cells(9, 3).Value

'Sous traitant
Sheets("intervenants").Cells(n, 4).Value = Feuil20.Cells(17, 3).Value

'Telephone fixe
Sheets("intervenants").Cells(n, 6).Value = Feuil20.Cells(10, 5).Value

'Portable resp 1
Sheets("intervenants").Cells(n, 8).Value = Feuil20.Cells(12, 5).Value

'Ville
Sheets("intervenants").Cells(n, 12).Value = Feuil20.Cells(9, 6).Value & "-" & Feuil20.Cells(9, 7).Value

'Fax
Sheets("intervenants").Cells(n, 7).Value = Feuil20.Cells(10, 7).Value

'Mail resp 1
Sheets("intervenants").Cells(n, 9).Value = Feuil20.Cells(12, 7).Value

Sheets("intervenants").Cells(n, 10).Value = "O"

'Code postal
Sheets("intervenants").Cells(n, 12).Value = Feuil20.Cells(9, 6).Value & "-" & Feuil20.Cells(9, 7).Value

If Feuil20.Cells(13, 3).Value <> "" Then
Sheets("intervenants").Cells(j, 2).Value = Feuil20.Cells(7, 3).Value 'entreprise
Sheets("intervenants").Cells(j, 11).Value = Feuil20.Cells(9, 3).Value 'adress
Sheets("intervenants").Cells(j, 4).Value = Feuil20.Cells(17, 3).Value 'sous traitant
Sheets("intervenants").Cells(j, 6).Value = Feuil20.Cells(10, 5).Value 'fixe
Sheets("intervenants").Cells(j, 8).Value = Feuil20.Cells(13, 5).Value 'Portable resp 2
Sheets("intervenants").Cells(j, 12).Value = Feuil20.Cells(9, 6).Value & "-" & Feuil20.Cells(9, 7).Value 'ville
Sheets("intervenants").Cells(j, 7).Value = Feuil20.Cells(10, 7).Value 'Fax
Sheets("intervenants").Cells(j, 9).Value = Feuil20.Cells(13, 7).Value 'Mail resp 2
Sheets("intervenants").Cells(j, 12).Value = Feuil20.Cells(9, 6).Value & "-" & Feuil20.Cells(9, 7).Value ' code postal
Sheets("intervenants").Cells(j, 10).Value = "O"
End If

'lot
Sheets("intervenants").Unprotect "1234"
Sheets("PPSPS").Unprotect "1234"
Sheets("intervenants").Cells(n, 3).Value = Feuil20.Cells(19, 3).Value

'Date début

Sheets("PPSPS").Cells(n, 14).Value = Feuil20.Cells(22, 4).Value
'Sheets("planning").Cells(n + 1, 4).Value = Feuil20.Cells(22, 4).Value

 'Date fin
Sheets("PPSPS").Cells(n, 15).Value = Feuil20.Cells(22, 6).Value
'Sheets("planning").Cells(n + 1, 5).Value = Feuil20.Cells(22, 6).Value

'Effectif moyen
Sheets("PPSPS").Cells(n, 16).Value = Feuil20.Cells(24, 4).Value

'Effectif de pointe
Sheets("PPSPS").Cells(n, 17).Value = Feuil20.Cells(24, 6).Value

'Membre CISSCT
Sheets("PPSPS").Cells(n, 18).Value = Feuil20.Range("H19").Value

Feuil20.Protect "1234", True, True, True
Sheets("intervenants").Protect "1234", True, True, True

While (Feuil3.Cells(i, 2).Value <> "")
    i = i + 1
    Wend

 Sheets("PPSPS").Unprotect "1234"
 Sheets("PPSPS").Cells(n, 6).Value = Feuil20.Range("H5").Value 'numéro IC
 Sheets("PPSPS").Cells(n, 5).Value = Feuil20.Range("E5").Value 'date IC

If Feuil20.Range("$D$126").Value = "Remis" Then
Sheets("PPSPS").Unprotect "1234"
Sheets("PPSPS").Cells(n, 7).Value = Feuil20.Range("E5").Value 'date PPSPS
Else
verif = True
Feuil3.Unprotect "1234"
Feuil3.Cells(i, 2).Value = "DEMANDE_DOC_INFO"
Feuil3.Unprotect "1234"
Feuil3.Cells(i, 9).Value = "PPS A REMETTRE"
Feuil3.Unprotect "1234"
Feuil3.Cells(i, 12).Value = Feuil20.Range("C7").Value

 Feuil3.Cells(i, 14).Locked = False

i = i + 1
End If

If UCase(Feuil20.Range("$D$96").Value) = "O" And Feuil20.Range("$D$128").Value = "Remis" Then 'Verifier si besoin de memeoire methodo et si oui si il a été remis

Sheets("PPSPS").Cells(n, 12).Value = Feuil20.Range("E5").Value
Feuil20.Unprotect "1234"
ElseIf UCase(Feuil20.Range("$D$96").Value) = "O" And Feuil20.Range("$D$128").Value <> "Remis" Then
verif = True
Feuil3.Unprotect "1234"
Feuil3.Cells(i, 2).Value = "DEMANDE_DOC_INFO" 'type d'observation
Feuil3.Unprotect "1234"
Feuil3.Cells(i, 9).Value = "MEMOIRE_METHODO A REMETTRE" 'nom du document
Feuil3.Unprotect "1234"
Feuil3.Cells(i, 12).Value = Feuil20.Range("C7").Value 'intervenants
Feuil3.Unprotect "1234"
'Feuil3.Range(Cells(i, 1), Cells(i, 13)).Locked = True
 Feuil3.Cells(i, 14).Locked = False
i = i + 1

End If

If UCase(Feuil20.Range("$D$115").Value) = "O" And Feuil20.Range("$D$127").Value = "Remis" Then 'Verifier si besoin de FDS et si oui si il a été remis

Feuil3.Unprotect "1234"
Sheets("PPSPS").Cells(n, 11).Value = Feuil20.Range("E5").Value

ElseIf UCase(Feuil20.Range("$D$115").Value) = "O" = True And Feuil20.Range("$D$127").Value <> "Remis" Then
verif = True
Feuil3.Unprotect "1234"
Feuil3.Cells(i, 2).Value = "DEMANDE_DOC_INFO"
Feuil3.Unprotect "1234"
Feuil3.Cells(i, 9).Value = "FDS_PRODUIT A REMETTRE"
Feuil3.Unprotect "1234"
Feuil3.Cells(i, 12).Value = Feuil20.Range("C7").Value
Feuil3.Unprotect "1234"
'Feuil3.Range(Cells(i, 1), Cells(i, 13)).Locked = True
 Feuil3.Cells(i, 14).Locked = False
i = i + 1
End If

Feuil20.Unprotect "1234"
Sheets("PPSPS").Unprotect "1234"

a = Format(Date, "dd-mmm-yy")

If Feuil20.Range("G129") <> "" Then 'autre document
verif = True
 Feuil3.Unprotect "1234"
 Feuil3.Cells(i, 2).Value = "DEMANDE_DOC_INFO"
 Feuil3.Unprotect "1234"
 Feuil3.Cells(i, 9).Value = Feuil20.Range("G129").Value
 Feuil3.Unprotect "1234"
 Feuil3.Cells(i, 12).Value = Feuil20.Range("C7").Value
 Feuil3.Unprotect "1234"
 'Feuil3.Range(Cells(i, 1), Cells(i, 13)).Locked = True
 Feuil3.Cells(i, 14).Locked = False
End If

'If verifde = True Then
 'Feuil3.Unprotect "1234"
  'Feuil3.Range("G5") = Feuil3.Range("G5") + 1
'End If

If Feuil20.CommandButton3.visible = True Then
Call Module3.Mail
End If

Sheets("intervenants").Unprotect "1234"
Call Module2.Date
'MsgBox "planning fait"
Call ModuleMail.Nouvelle
'MsgBox "nouvell ic fait"
'Call ModuleListe.liste
'MsgBox "liste fait"

Feuil20.Protect "1234", True, True, True
Sheets("intervenants").Protect "1234", True, True, True

 'test = False

Feuil3.Activate
Call ModuleCouleur.coloration
Feuil20.Activate

Feuil20.Shapes("CommandButton3").Top = "3140"
Feuil20.Shapes("CommandButton3").Width = "168,75"
Feuil20.Shapes("CommandButton3").Left = "14,25"
Feuil20.Shapes("CommandButton3").Height = "46,5"

Feuil20.Shapes("CommandButton2").Top = "3140"
Feuil20.Shapes("CommandButton2").Width = "168,75"
Feuil20.Shapes("CommandButton2").Left = "554,25"
Feuil20.Shapes("CommandButton2").Height = "46,5"

'If Feuil20.CommandButton3.visible = False Then
'Transfert.Show 0
'End If

Application.ScreenUpdating = True
Feuil3.Protect "1234", True, True, True
Feuil20.Protect "1234", True, True, True

MsgBox "Derniere Ligne"

End Sub

Code dans la UserForme

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then Cancel = True
Application.EnableEvents = True

End Sub

Private Sub CommandButton1_Click()
Dim i As Integer, DernLigne As Integer

DernLigne = Feuil3.Range("B105650").Endd(xlUp).Row
For i = 22 To DernLigne
Sheets("compte srnedus").Cells(i, 1).Value = Sheets("compte srnedus").Cells(i - 1, 1).Value + 1
Next
Feuil20.Unprotect "1234"
Feuil20.CommandButton3.visible = True
Feuil20.Protect "1234", True, True, True

Application.EnableEvents = True
Feuil3.Protect "1234", True, True, True
'Sheets("intervenants").Protect "1234", True, True, True
'Feuil20.Protect "1234", True, True, True
Application.EnableEvents = True
Unload Transfert
End Sub

En gros je lance la première macro puis j'ai ma UserForm qui apparaît et reste affiché mais après la deuxième macro pouf ça disparaît, alors que j'ai encore besoin de l'avoir afficher jusqu'à que je clique sur le bouton de la UserForme.

Bonjour, eric,

Non je viens d'essayer la UsF n’apparaît pas

Je me suis fait une reflexion qui n'a peut être rien à voir mais je lance ma macro depuis un Private Sub....() pcq c'est un bouton donc est ce que l'ouvrir depuis un Sub ou un Public Sub pourrait résoudre le problème ?

EDIT: J'ai essayé et ça marche pas

Rechercher des sujets similaires à "empecher fermeture userform"