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