Problème userform

Bonjour à tous

Je voudrais créer un bouton annuler dans un userform qui est appelé par un code dans une feuille.

Je voudrais savoir comment est il possible de faire un exit sub dans la feuille.

le code de la feuille

Option Explicit
Global Lignebouton As String
Sub CréerBouton(Optional Sh As Worksheet, Optional Emplacement As Range)
Dim Obj As Object
Dim Code As String
Dim A As Variant
Dim B As Variant
Dim nb As Integer
Dim Tb As Object

B = ActiveSheet.Name
Sheets(B).Select
'créer le bouton

With Emplacement
'Position du bouton
    Range("F10").Select
    Set Obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Togglebutton.1", _
    Link:=False, DisplayAsIcon:=False, Left:=ActiveCell.Left + 1, Top:=ActiveCell.Top + 1, Width:=ActiveCell.Width - 2, _
    Height:=ActiveCell.Height - 0.5)

End With

Sheets(B).Select
    nb = 0
    For A = 1 To ActiveSheet.OLEObjects.Count
        'MsgBox ActiveSheet.OLEObjects(i).Name
       On Error GoTo terreur
        Set Tb = ActiveSheet.OLEObjects("ToggleButton" & A)
        On Error GoTo 0
        If nb <> 0 Then Exit For
    Next A
    'MsgBox A
If nb = 0 Then nb = A
Obj.Name = "ToggleButton" & A
'MsgBox A

'texte du bouton
     ActiveSheet.OLEObjects("ToggleButton" & A).Object.Caption = "OK"

'Le texte de la macro

    Code = "Private Sub ToggleButton" & A & "_Click()" & vbCrLf
    'Code = Code & "Call BoutonName" & vbCrLf
    Code = Code & "B = ActiveSheet.Name" & vbCrLf
    Code = Code & "" & vbCrLf
    Code = Code & "Dim Ligne As Long" & vbCrLf
    Code = Code & "Dim Debut As Long" & vbCrLf
    Code = Code & "Dim Fin As integer" & vbCrLf
    'Code = Code & "bouton = ToggleButton" & A & ".Name" & vbCrLf ' on mémorise le nom du bouton dans boutonmeudon avant lancer userform3
    Code = Code & "" & vbCrLf
    Code = Code & "If ToggleButton" & A & ".Value = True Then" & vbCrLf
    Code = Code & "" & vbCrLf
    Code = Code & "Y = Cells(1, 1).Height" & vbCrLf
    Code = Code & "Ligne = 1" & vbCrLf
    Code = Code & "While Y < ToggleButton" & A & ".Top" & vbCrLf
    Code = Code & "Ligne = Ligne + 1" & vbCrLf
    Code = Code & "Y = Y + Cells(Ligne, 1).Height" & vbCrLf
    Code = Code & "Wend" & vbCrLf
    Code = Code & "Lignebouton = ligne" & vbCrLf
    Code = Code & "" & vbCrLf
    Code = Code & "If Sheets(B).Range(""B10:E10"").Interior.Color = RGB(200, 35, 15) or Sheets(B).Range(""B10:E10"").Interior.Color = RGB(100, 169, 27)  then" & vbCrLf
    Code = Code & "UserForm3.Show" & vbCrLf
    Code = Code & "MsgBox Userform3.textbox4.value, vbYesNo" & vbCrLf
    Code = Code & "If Userform3.textbox4.value = 1 and Userform3.textbox5.value = 1 then" & vbCrLf
    Code = Code & "MsgBox ""Confirmer 2"", vbYesNo" & vbCrLf
    Code = Code & "Exit sub" & vbCrLf
    Code = Code & "End If" & vbCrLf
    Code = Code & "Sheets(B).Select" & vbCrLf
    Code = Code & "End If" & vbCrLf
    'Code = Code & "If MsgBox(""Confirmer"", vbYesNo) = vbYes Then" & vbCrLf
    Code = Code & "" & vbCrLf
    Code = Code & "Sheets(B).Select" & vbCrLf
    Code = Code & "Rows(Ligne).Select" & vbCrLf
    Code = Code & "Selection.Delete Shift:=xlUp" & vbCrLf
    Code = Code & "With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule" & vbCrLf
    Code = Code & "Debut = .ProcStartLine(ToggleButton" & A & ".Name" & "" & " & ""_Click"", vbext_pk_Proc)" & vbCrLf
    Code = Code & "Fin = .ProcCountLines(ToggleButton" & A & ".Name" & "" & " & ""_Click"", vbext_pk_Proc)" & vbCrLf
    Code = Code & ".DeleteLines Debut, Fin " & vbCrLf
    Code = Code & ".CodePane.Window.Close" & vbCrLf
    Code = Code & "End With" & vbCrLf
    Code = Code & "ActiveSheet.Shapes(""ToggleButton" & A & """).Visible = True" & vbCrLf
    Code = Code & "ActiveSheet.Shapes(""ToggleButton" & A & """).select" & vbCrLf
    Code = Code & "Selection.Delete" & vbCrLf
    Code = Code & "Else" & vbCrLf
    Code = Code & "" & vbCrLf
    Code = Code & "End If" & vbCrLf
    Code = Code & "Sheets(B).Select" & vbCrLf
    'Code = Code & "End If" & vbCrLf
    Code = Code & "End Sub"

With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
   .insertlines .CountOfLines + 1, Code
End With

Exit Sub
terreur: 'routine de traitement d'erreur, ne doit être exécutée que si il y a une erreur !
     nb = A
Resume Next
End Sub

le code du userform

Private Sub CommandButton2_Click()

UserForm3.TextBox4.Value = "1"

UserForm3.TextBox5.Value = "1"

Unload Me

End Sub

Merci

Bonjour,

Je n'ai pas l'impression que tu aies un problème de UserForm ...

Dans la mesure où tu veux écrire du code VBA qui modifie du code VBA, tu as besoin d'ajouter à ton éditeur dans les Outils une référence à Microsoft Visual Basic For Applications Extensibility 5.3 ...(ou plus...)

Bon Courage

Bonjour,

C'est pas possible quand je quitte le userform3 de nommer les textbox4 et textbox5 d'une certaine manière et créer un condition dans la feuille ?

Dans le userform3

Private Sub CommandButton2_Click()

UserForm3.TextBox4.Value = "1"
UserForm3.TextBox5.Value = "1"
Unload Me
End Sub

Dans la feuille

Code = Code & "If Userform3.textbox4.value = 1 and Userform3.textbox5.value = 1 then" & vbCrLf

Code = Code & "Exit sub" & vbCrLf

C'est un peu a l'arrache mais bon ..

Merci d'avance

Rechercher des sujets similaires à "probleme userform"