Microsoft 365 Problème affichage userform après insertion du code

Adrien60 · 18 Novembre 2020

Bonjour,

J'ai encore un problème.
Lorsque je créé mon userform avec un code du style:

VB:

Sub Création(UsfName As String)
Dim UsfForm As Object
Set UsfForm = ThisWorkbook.VBProject.VBComponents.Add(3)
    With UsfForm
        .Name = UsfName
    End with
end sub

j'arrive à l'afficher avec :

Code:

Sub ShowAnyForm(FormName As String, Optional Modal As FormShowConstants = vbModal)
 
        For Each obj In VBA.UserForms
            If StrComp(obj.Name, FormName, vbTextCompare) = 0 Then
                obj.Show Modal
                Exit Sub
            End If
        Next obj
          
        With VBA.UserForms
            On Error Resume Next
            Err.Clear
            Set obj = .Add(FormName)
            If Err.Number <> 0 Then
                MsgBox "Err: " & CStr(Err.Number) & "   " & Err.Description
                Exit Sub
            End If
            obj.Show Modal
        End With
        
    
End Sub

mais dés que j'insert du code dans mon userform avec:

Code:

Sub Création(UsfName As String)

Dim UsfForm As Object
Dim x as Integer

Set UsfForm = ThisWorkbook.VBProject.VBComponents.Add(3)

    With UsfForm
        .Name = UsfName
    End with
    
    With UsfForm.CodeModule
        x = .CountOfLines
        .InsertLines x + 1, "Private Sub CheckAutreMAuto_Click()"
        .InsertLines x + 2, "If CheckAutreMAuto.Value = False Then"
        .InsertLines x + 3, "CombienMAuto.Enabled = False"
        .InsertLines x + 4, "Else: CombienMAuto.Enabled = True"
        .InsertLines x + 5, "End If"
        .InsertLines x + 6, "End Sub"
    End with
End sub

mon userform ne veut plus s'afficher. J'ai essayé de le renommer avant de l'afficher avec UsfForm.Name=UsfName mais ça fonctionne pas, je suis perdu.

Rhysand · 20 Novembre 2020

Bonjour à tous

votre projet a demandé du travail
beaucoup d'erreurs

J'ai adapté quelques changements

fichier Excel joint

Phil69970 · 18 Novembre 2020

Bonjour Adrien, le forum

Une piste... non testé.

En 1 tu crées ton UsF
en 2 tu crées le code de UsF

VB:

Sub Création(UsfName As String)

Dim UsfForm As Object
Dim x as Integer

'1)
Set UsfForm = ThisWorkbook.VBProject.VBComponents.Add(3)

    With UsfForm
        .Name = UsfName
    End with

'2)
With UsfForm.CodeModule
        x = .CountOfLines
        .InsertLines x + 1, "Private Sub CheckAutreMAuto_Click()"
        .InsertLines x + 2, "If CheckAutreMAuto.Value = False Then"
        .InsertLines x + 3, "CombienMAuto.Enabled = False"
        .InsertLines x + 4, "Else: CombienMAuto.Enabled = True"
        .InsertLines x + 5, "End If"
        .InsertLines x + 6, "End Sub"
End with

End sub

@Phil69970

Adrien60 · 18 Novembre 2020

Phil69970 à dit:

Bonjour Adrien, le forum

Une piste... non testé.

En 1 tu crées ton UsF
en 2 tu crées le code de UsF

VB:

Sub Création(UsfName As String)

Dim UsfForm As Object
Dim x as Integer

'1)
Set UsfForm = ThisWorkbook.VBProject.VBComponents.Add(3)

    With UsfForm
        .Name = UsfName
    End with

'2)
With UsfForm.CodeModule
        x = .CountOfLines
        .InsertLines x + 1, "Private Sub CheckAutreMAuto_Click()"
        .InsertLines x + 2, "If CheckAutreMAuto.Value = False Then"
        .InsertLines x + 3, "CombienMAuto.Enabled = False"
        .InsertLines x + 4, "Else: CombienMAuto.Enabled = True"
        .InsertLines x + 5, "End If"
        .InsertLines x + 6, "End Sub"
End with

End sub

@Phil69970

j'ai déja essayé de remplacer le 2) par un appel a une fonction qui insert le code genre: InsertCode UsfName, mais ça change rien.
Pour précision mon où mes userform se créent bien mais ils ne s'affichent pas

Phil69970 · 18 Novembre 2020

Adrien le forum

Un peu de lecture

http://dj.joss.free.fr/ecrisub.htm

@Phil69970

Adrien60 · 18 Novembre 2020

Phil69970 à dit:
Adrien le forum

Un peu de lecture

http://dj.joss.free.fr/ecrisub.htm

@Phil69970

Merci mais j ai beau lire et relire je vois pas ce qui cloche. La méthode d'insertion du code semble correct et pourtant c est elle qui fait que l userform ne s affiche pas. Je ne comprends vraiment pas.

Rhysand · 19 Novembre 2020

Bonsoir à tous

pour tester, vous pouvez tout mettre sur un Userform

ajouter à ce UserForm : 2 CommandButton ==>(CommandButton2 e CommandButton3)
ajouter à ce UserForm : 1 label ==>(label1)
ajouter à ce UserForm : 2 textbox ==>(textbox1 e textbox2)

textbox1 avec: EnterKeyBehavior = true / Multiline=true

VB:

Option Explicit


Private Sub CommandButton2_Click()

If Me.TextBox2.Value = "" Then MsgBox "Le nom du UserForm n'a pas été saisi!", vbExclamation, "Information!": Exit Sub

Dim myForm As Object
Dim NewFrame As MSForms.Frame               ' Control - frame
Dim NewButton As MSForms.CommandButton      ' Control - CommandButton
Dim NewButton_2 As MSForms.CommandButton    ' Control - CommandButton
Dim NewComboBox As MSForms.ComboBox         ' Control - ComboBox
Dim NewLabel As MSForms.Label               ' Control - Label
Dim NewImage As MSForms.Image               ' Control - Image
Dim NewOptionButton As MSForms.OptionButton ' Control - OptionButton
Dim NewListBox As MSForms.ListBox           ' Control - ListBox
Dim NewCheckBox As MSForms.CheckBox         ' Control - CheckBox
Dim NewTextBox As MSForms.TextBox           ' Control - TextBox

Dim X As Integer
Dim Line As Integer
Dim usfName As String
Dim checkLocked As Excel.Workbook
Dim workbookName As String

workbookName = Application.ThisWorkbook.Name
Set checkLocked = Application.Workbooks(workbookName)
   
If checkLocked.VBProject.Protection = 1 Then
    MsgBox "Erreur: VBE est protégé!", vbCritical, "Information!"
    If Not checkLocked Is Nothing Then Set checkLocked = Nothing
    Exit Sub
End If

usfName = Me.TextBox2.Text

If Not usfExists(usfName) = False Then MsgBox "Le nom du nouveau UserForm existe déjà", vbExclamation, "Information!": Exit Sub

Application.VBE.MainWindow.Visible = False

Set myForm = Application.ThisWorkbook.VBProject.VBComponents.Add(3)
Set NewListBox = myForm.Designer.Controls.Add("Forms.listbox.1")
Set NewButton = myForm.Designer.Controls.Add("Forms.commandbutton.1")
Set NewButton_2 = myForm.Designer.Controls.Add("Forms.commandbutton.1")
Set NewLabel = myForm.Designer.Controls.Add("Forms.label.1")
Set NewTextBox = myForm.Designer.Controls.Add("Forms.textbox.1")
Set NewImage = myForm.Designer.Controls.Add("Forms.image.1")
'Set NewCheckBox = myForm.Designer.Controls.Add("Forms.checkbox.1")
'Set NewOptionButton = myForm.Designer.Controls.Add("Forms.optionbutton.1")
'Set NewFrame = myForm.Designer.Controls.Add("Forms.frame.1")
'Set NewComboBox = myForm.Designer.Controls.Add("Forms.combobox.1")

''add userform
With myForm
    .Properties("Name") = usfName
    .Properties("Caption") = "New Form"
    .Properties("Width") = 500
    .Properties("Height") = 350
End With

''add CommandButton
With NewButton
    .Name = "myButton"
    .Caption = "Bouton de commande"
    .Top = 10
    .Left = 200
    .Width = 120
    .Height = 20
    .Font.Size = 10
    .Font.Name = "Times New Roman"
    .BackStyle = fmBackStyleOpaque
    .BackColor = &H8000000F
End With

''add Label
With NewLabel
    .Name = "mylabel"
    .Top = 45
    .Left = 200
    .Width = 50
    .Height = 18
    .Font.Size = 10
    .Font.Name = "Times New Roman"
    .BackStyle = fmBackStyleTransparent
End With

''add Image
With NewImage
    .Name = "myImage"
    .Top = 120
    .Left = 200
    .Width = 100
    .Height = 100
    .BackColor = &HC0FFFF
End With

''add CommandButton
With NewButton_2
    .Name = "myButton2"
    .Caption = "Bouton de image"
    .Top = 100
    .Left = 200
    .Width = 120
    .Height = 20
    .Font.Size = 10
    .Font.Name = "Times New Roman"
    .BackStyle = fmBackStyleOpaque
    .BackColor = &H8000000F
End With

''add TextBox
With NewTextBox
    .Name = "myTextbox"
    .Top = 60
    .Left = 200
    .Width = 150
    .Height = 18
    .Font.Size = 10
    .Font.Name = "Times New Roman"
    .SpecialEffect = fmSpecialEffectBump
End With

''add ListBox
With NewListBox
    .Name = "myListbox"
    .Top = 10
    .Left = 10
    .Width = 150
    .Height = 200
    .Font.Size = 10
    .Font.Name = "Times New Roman"
    .SpecialEffect = fmSpecialEffectSunken
End With

''add code
myForm.CodeModule.InsertLines 1, "Private Sub UserForm_Initialize()"
myForm.CodeModule.InsertLines 2, "   Me.myListbox.addItem ""Listbox line nº 1"" "
myForm.CodeModule.InsertLines 3, "   Me.myListbox.addItem ""Listbox line nº 2"" "
myForm.CodeModule.InsertLines 4, "   Me.myListbox.addItem ""Listbox line nº 3"" "
myForm.CodeModule.InsertLines 5, "   Me.mylabel.caption = ""Label texte"" "
myForm.CodeModule.InsertLines 6, "   Me.myTextbox.text=  ""textbox texte"" "
myForm.CodeModule.InsertLines 7, "End Sub"
myForm.CodeModule.InsertLines 8, "     "
myForm.CodeModule.InsertLines 9, "Private Sub myListbox_Click()"
myForm.CodeModule.InsertLines 10, "   Dim i As Integer "
myForm.CodeModule.InsertLines 11, "   i = 0 "
myForm.CodeModule.InsertLines 12, "   If Me.myListbox.ListCount = 0 Then "
myForm.CodeModule.InsertLines 13, "      i = 0 "
myForm.CodeModule.InsertLines 14, "   Else"
myForm.CodeModule.InsertLines 15, "      i = Me.myListbox.ListCount"
myForm.CodeModule.InsertLines 16, "   End If "
myForm.CodeModule.InsertLines 17, "   Debug.Print i "
myForm.CodeModule.InsertLines 18, "   If i = 0 Then Exit Sub "
myForm.CodeModule.InsertLines 19, "     "
myForm.CodeModule.InsertLines 20, "   Me.myTextbox.Text = Me.myListbox.list(Me.myListbox.ListIndex, 0) "
myForm.CodeModule.InsertLines 21, "End Sub "
myForm.CodeModule.InsertLines 22, "     "
myForm.CodeModule.InsertLines 23, "Private Sub myButton_Click()"
myForm.CodeModule.InsertLines 24, "   If me.myListbox.text <>"""" Then"
myForm.CodeModule.InsertLines 25, "      msgbox (""texte sélectionné: "" & vbcrlf & vbcrlf & me.myListbox.text ), vbInformation,""Information!"""
myForm.CodeModule.InsertLines 26, "   Else "
myForm.CodeModule.InsertLines 27, "      msgbox (""sélectionnez d'abord les données de la ListBox: ""), vbCritical,""Information!"""
myForm.CodeModule.InsertLines 28, "   End If "
myForm.CodeModule.InsertLines 29, "End Sub "
myForm.CodeModule.InsertLines 30, "  "
myForm.CodeModule.InsertLines 31, "Private Sub myButton2_Click()"
myForm.CodeModule.InsertLines 32, "   Dim strFileName As String "
myForm.CodeModule.InsertLines 33, "   On Error Resume Next "
myForm.CodeModule.InsertLines 34, "   strFileName = Application.GetOpenFilename(FileFilter:=""Tiff Files(*.tif;*.tiff),*.tif;*.tiff,JPEG Files (*.jpg;*.jpeg;*.jfif;*.jpe),*.jpg;*.jpeg;*.jfif;*.jpe,Bitmap Files(*.bmp),*.bmp"", FilterIndex:=2, Title:=""Select a File"", MultiSelect:=False) "
myForm.CodeModule.InsertLines 35, "   If strFileName = ""False"" Then exit sub "
myForm.CodeModule.InsertLines 36, "   Me.myImage.Picture = LoadPicture(strFileName) "
myForm.CodeModule.InsertLines 37, "   Me.myImage.PictureSizeMode = fmPictureSizeModeClip "
myForm.CodeModule.InsertLines 38, "   Me.Repaint "
myForm.CodeModule.InsertLines 39, "End Sub "

VBA.UserForms.Add(myForm.Name).Show

'If Not NewFrame Is Nothing Then Set NewFrame = Nothing
'If Not NewComboBox Is Nothing Then Set NewComboBox = Nothing
'If Not NewOptionButton Is Nothing Then Set NewOptionButton = Nothing
'If Not NewCheckBox Is Nothing Then Set NewCheckBox = Nothing
If Not NewLabel Is Nothing Then Set NewLabel = Nothing
If Not NewTextBox Is Nothing Then Set NewTextBox = Nothing
If Not checkLocked Is Nothing Then Set checkLocked = Nothing
If Not NewButton Is Nothing Then Set NewButton = Nothing
If Not NewButton_2 Is Nothing Then Set NewButton_2 = Nothing
If Not NewListBox Is Nothing Then Set NewListBox = Nothing
If Not NewImage Is Nothing Then Set NewImage = Nothing
If Not myForm Is Nothing Then Set myForm = Nothing

End Sub

Public Function usfExists(xName As String) As Boolean

Dim VBC As VBIDE.VBComponent

For Each VBC In Application.ThisWorkbook.VBProject.VBComponents
    If VBC.Type = vbext_ct_MSForm Then
        If VBC.Name = xName Then
            Debug.Print VBC.Name
            usfExists = True
            Exit Function
        End If
    End If
Next VBC
   
usfExists = False
   
End Function

Private Sub CommandButton3_Click() '

If Me.TextBox2.Value = "" Then MsgBox "Le nom du UserForm n'a pas été saisi!", vbExclamation, "Information!": Exit Sub
If Me.TextBox1.Value = "" Then MsgBox "Aucune donnée n'a été saisie pour la macro!", vbCritical, "Information!": Exit Sub

Dim usfName As String
Dim strText() As String
Dim i As Integer
Dim j As Integer
Dim StartLine As Long
Dim NumLines As Long
Dim ProcName As String
Dim s As String
Dim firstChar As Long
Dim secondChar As Long
Dim count As Long
Dim checkLocked As Excel.Workbook
Dim workbookName As String
Dim code As String
Dim NextLine As Integer

workbookName = Application.ThisWorkbook.Name
Set checkLocked = Application.Workbooks(workbookName)
   
If checkLocked.VBProject.Protection = 1 Then
    MsgBox "Erreur: VBE est protégé!", vbCritical, "Information!"
    If Not checkLocked Is Nothing Then Set checkLocked = Nothing
    Exit Sub
End If

usfName = Me.TextBox2.Text

If Not usfExists(usfName) = True Then MsgBox "Ce nom de UserForm n'existe pas ou est introuvable!", vbExclamation, "Information!": Exit Sub

strText = Split(Me.TextBox1.Text, vbCrLf)
j = Me.Label1.Caption

On Error Resume Next
For i = 0 To j
    code = code & strText(i) & vbCrLf
Next i

ProcName = strText(0)
On Error GoTo 0

If ProcName = "" Then MsgBox "première ligne de la macro sans données!", vbCritical, "Information!": Exit Sub

Debug.Print ProcName

s = ProcName
s = VBA.Left(s, VBA.InStr(s, " ") - 1)
Debug.Print s

If checkWords(s, "Private", "Public") Then
    ' is ok
Else
    ' wrong data
    MsgBox "première ligne de la macro avec des erreurs, elle doit commencer par le mot (Private ou Public)!", vbCritical, "Information!"
    Exit Sub
End If

s = ProcName
Debug.Print s

firstChar = InStr(s, "Sub") + 4
secondChar = InStr(firstChar, s, "(")

count = (secondChar - firstChar)

s = VBA.Mid(s, firstChar, count)
Debug.Print s

If Not checkMacroName(usfName, s) = True Then
    ' NO exists
Else
    ' name exists
    MsgBox "le nom de la macro existe déjà dans le module userform!", vbCritical, "Information!"
    Exit Sub
End If

With ThisWorkbook.VBProject.VBComponents(usfName).CodeModule
    NextLine = .CountOfLines + 1
    .InsertLines NextLine, code
End With

MsgBox "nouveau code ajouté!", vbInformation, "Information!"

End Sub

Private Sub TextBox1_Change()

Me.Label1.Caption = Me.TextBox1.LineCount

End Sub

Public Function checkMacroName(MyModuleName As String, MySub As String) As Boolean '

Dim MyModule As Object
Dim MyLine As Long
   
Set MyModule = ActiveWorkbook.VBProject.VBComponents(MyModuleName).CodeModule
On Error Resume Next
MyLine = MyModule.ProcStartLine(MySub, vbext_pk_Proc)

If Err.Number <> 0 Then ' error
    checkMacroName = False
Else
    checkMacroName = True
End If
   
Set MyModule = Nothing

End Function

Public Function checkWords(s As String, ParamArray xCompare()) As Boolean

Dim i As Long

For i = 0 To UBound(xCompare)
    If s = xCompare(i) Then
        checkWords = True
        Exit Function
    End If
Next i

checkWords = False

End Function

Adrien60 · 19 Novembre 2020

Rhysand à dit:

Bonsoir à tous

pour tester, vous pouvez tout mettre sur un Userform

ajouter à ce UserForm : 2 CommandButton ==>(CommandButton2 e CommandButton3)
ajouter à ce UserForm : 1 label ==>(label1)
ajouter à ce UserForm : 2 textbox ==>(textbox1 e textbox2)

textbox1 avec: EnterKeyBehavior = true / Multiline=true

VB:

Option Explicit


Private Sub CommandButton2_Click()

If Me.TextBox2.Value = "" Then MsgBox "Le nom du UserForm n'a pas été saisi!", vbExclamation, "Information!": Exit Sub

Dim myForm As Object
Dim NewFrame As MSForms.Frame               ' Control - frame
Dim NewButton As MSForms.CommandButton      ' Control - CommandButton
Dim NewButton_2 As MSForms.CommandButton    ' Control - CommandButton
Dim NewComboBox As MSForms.ComboBox         ' Control - ComboBox
Dim NewLabel As MSForms.Label               ' Control - Label
Dim NewImage As MSForms.Image               ' Control - Image
Dim NewOptionButton As MSForms.OptionButton ' Control - OptionButton
Dim NewListBox As MSForms.ListBox           ' Control - ListBox
Dim NewCheckBox As MSForms.CheckBox         ' Control - CheckBox
Dim NewTextBox As MSForms.TextBox           ' Control - TextBox

Dim X As Integer
Dim Line As Integer
Dim usfName As String
Dim checkLocked As Excel.Workbook
Dim workbookName As String

workbookName = Application.ThisWorkbook.Name
Set checkLocked = Application.Workbooks(workbookName)
  
If checkLocked.VBProject.Protection = 1 Then
    MsgBox "Erreur: VBE est protégé!", vbCritical, "Information!"
    If Not checkLocked Is Nothing Then Set checkLocked = Nothing
    Exit Sub
End If

usfName = Me.TextBox2.Text

If Not usfExists(usfName) = False Then MsgBox "Le nom du nouveau UserForm existe déjà", vbExclamation, "Information!": Exit Sub

Application.VBE.MainWindow.Visible = False

Set myForm = Application.ThisWorkbook.VBProject.VBComponents.Add(3)
Set NewListBox = myForm.Designer.Controls.Add("Forms.listbox.1")
Set NewButton = myForm.Designer.Controls.Add("Forms.commandbutton.1")
Set NewButton_2 = myForm.Designer.Controls.Add("Forms.commandbutton.1")
Set NewLabel = myForm.Designer.Controls.Add("Forms.label.1")
Set NewTextBox = myForm.Designer.Controls.Add("Forms.textbox.1")
Set NewImage = myForm.Designer.Controls.Add("Forms.image.1")
'Set NewCheckBox = myForm.Designer.Controls.Add("Forms.checkbox.1")
'Set NewOptionButton = myForm.Designer.Controls.Add("Forms.optionbutton.1")
'Set NewFrame = myForm.Designer.Controls.Add("Forms.frame.1")
'Set NewComboBox = myForm.Designer.Controls.Add("Forms.combobox.1")

''add userform
With myForm
    .Properties("Name") = usfName
    .Properties("Caption") = "New Form"
    .Properties("Width") = 500
    .Properties("Height") = 350
End With

''add CommandButton
With NewButton
    .Name = "myButton"
    .Caption = "Bouton de commande"
    .Top = 10
    .Left = 200
    .Width = 120
    .Height = 20
    .Font.Size = 10
    .Font.Name = "Times New Roman"
    .BackStyle = fmBackStyleOpaque
    .BackColor = &H8000000F
End With

''add Label
With NewLabel
    .Name = "mylabel"
    .Top = 45
    .Left = 200
    .Width = 50
    .Height = 18
    .Font.Size = 10
    .Font.Name = "Times New Roman"
    .BackStyle = fmBackStyleTransparent
End With

''add Image
With NewImage
    .Name = "myImage"
    .Top = 120
    .Left = 200
    .Width = 100
    .Height = 100
    .BackColor = &HC0FFFF
End With

''add CommandButton
With NewButton_2
    .Name = "myButton2"
    .Caption = "Bouton de image"
    .Top = 100
    .Left = 200
    .Width = 120
    .Height = 20
    .Font.Size = 10
    .Font.Name = "Times New Roman"
    .BackStyle = fmBackStyleOpaque
    .BackColor = &H8000000F
End With

''add TextBox
With NewTextBox
    .Name = "myTextbox"
    .Top = 60
    .Left = 200
    .Width = 150
    .Height = 18
    .Font.Size = 10
    .Font.Name = "Times New Roman"
    .SpecialEffect = fmSpecialEffectBump
End With

''add ListBox
With NewListBox
    .Name = "myListbox"
    .Top = 10
    .Left = 10
    .Width = 150
    .Height = 200
    .Font.Size = 10
    .Font.Name = "Times New Roman"
    .SpecialEffect = fmSpecialEffectSunken
End With

''add code
myForm.CodeModule.InsertLines 1, "Private Sub UserForm_Initialize()"
myForm.CodeModule.InsertLines 2, "   Me.myListbox.addItem ""Listbox line nº 1"" "
myForm.CodeModule.InsertLines 3, "   Me.myListbox.addItem ""Listbox line nº 2"" "
myForm.CodeModule.InsertLines 4, "   Me.myListbox.addItem ""Listbox line nº 3"" "
myForm.CodeModule.InsertLines 5, "   Me.mylabel.caption = ""Label texte"" "
myForm.CodeModule.InsertLines 6, "   Me.myTextbox.text=  ""textbox texte"" "
myForm.CodeModule.InsertLines 7, "End Sub"
myForm.CodeModule.InsertLines 8, "     "
myForm.CodeModule.InsertLines 9, "Private Sub myListbox_Click()"
myForm.CodeModule.InsertLines 10, "   Dim i As Integer "
myForm.CodeModule.InsertLines 11, "   i = 0 "
myForm.CodeModule.InsertLines 12, "   If Me.myListbox.ListCount = 0 Then "
myForm.CodeModule.InsertLines 13, "      i = 0 "
myForm.CodeModule.InsertLines 14, "   Else"
myForm.CodeModule.InsertLines 15, "      i = Me.myListbox.ListCount"
myForm.CodeModule.InsertLines 16, "   End If "
myForm.CodeModule.InsertLines 17, "   Debug.Print i "
myForm.CodeModule.InsertLines 18, "   If i = 0 Then Exit Sub "
myForm.CodeModule.InsertLines 19, "     "
myForm.CodeModule.InsertLines 20, "   Me.myTextbox.Text = Me.myListbox.list(Me.myListbox.ListIndex, 0) "
myForm.CodeModule.InsertLines 21, "End Sub "
myForm.CodeModule.InsertLines 22, "     "
myForm.CodeModule.InsertLines 23, "Private Sub myButton_Click()"
myForm.CodeModule.InsertLines 24, "   If me.myListbox.text <>"""" Then"
myForm.CodeModule.InsertLines 25, "      msgbox (""texte sélectionné: "" & vbcrlf & vbcrlf & me.myListbox.text ), vbInformation,""Information!"""
myForm.CodeModule.InsertLines 26, "   Else "
myForm.CodeModule.InsertLines 27, "      msgbox (""sélectionnez d'abord les données de la ListBox: ""), vbCritical,""Information!"""
myForm.CodeModule.InsertLines 28, "   End If "
myForm.CodeModule.InsertLines 29, "End Sub "
myForm.CodeModule.InsertLines 30, "  "
myForm.CodeModule.InsertLines 31, "Private Sub myButton2_Click()"
myForm.CodeModule.InsertLines 32, "   Dim strFileName As String "
myForm.CodeModule.InsertLines 33, "   On Error Resume Next "
myForm.CodeModule.InsertLines 34, "   strFileName = Application.GetOpenFilename(FileFilter:=""Tiff Files(*.tif;*.tiff),*.tif;*.tiff,JPEG Files (*.jpg;*.jpeg;*.jfif;*.jpe),*.jpg;*.jpeg;*.jfif;*.jpe,Bitmap Files(*.bmp),*.bmp"", FilterIndex:=2, Title:=""Select a File"", MultiSelect:=False) "
myForm.CodeModule.InsertLines 35, "   If strFileName = ""False"" Then exit sub "
myForm.CodeModule.InsertLines 36, "   Me.myImage.Picture = LoadPicture(strFileName) "
myForm.CodeModule.InsertLines 37, "   Me.myImage.PictureSizeMode = fmPictureSizeModeClip "
myForm.CodeModule.InsertLines 38, "   Me.Repaint "
myForm.CodeModule.InsertLines 39, "End Sub "

VBA.UserForms.Add(myForm.Name).Show

'If Not NewFrame Is Nothing Then Set NewFrame = Nothing
'If Not NewComboBox Is Nothing Then Set NewComboBox = Nothing
'If Not NewOptionButton Is Nothing Then Set NewOptionButton = Nothing
'If Not NewCheckBox Is Nothing Then Set NewCheckBox = Nothing
If Not NewLabel Is Nothing Then Set NewLabel = Nothing
If Not NewTextBox Is Nothing Then Set NewTextBox = Nothing
If Not checkLocked Is Nothing Then Set checkLocked = Nothing
If Not NewButton Is Nothing Then Set NewButton = Nothing
If Not NewButton_2 Is Nothing Then Set NewButton_2 = Nothing
If Not NewListBox Is Nothing Then Set NewListBox = Nothing
If Not NewImage Is Nothing Then Set NewImage = Nothing
If Not myForm Is Nothing Then Set myForm = Nothing

End Sub

Public Function usfExists(xName As String) As Boolean

Dim VBC As VBIDE.VBComponent

For Each VBC In Application.ThisWorkbook.VBProject.VBComponents
    If VBC.Type = vbext_ct_MSForm Then
        If VBC.Name = xName Then
            Debug.Print VBC.Name
            usfExists = True
            Exit Function
        End If
    End If
Next VBC
  
usfExists = False
  
End Function

Private Sub CommandButton3_Click() '

If Me.TextBox2.Value = "" Then MsgBox "Le nom du UserForm n'a pas été saisi!", vbExclamation, "Information!": Exit Sub
If Me.TextBox1.Value = "" Then MsgBox "Aucune donnée n'a été saisie pour la macro!", vbCritical, "Information!": Exit Sub

Dim usfName As String
Dim strText() As String
Dim i As Integer
Dim j As Integer
Dim StartLine As Long
Dim NumLines As Long
Dim ProcName As String
Dim s As String
Dim firstChar As Long
Dim secondChar As Long
Dim count As Long
Dim checkLocked As Excel.Workbook
Dim workbookName As String
Dim code As String
Dim NextLine As Integer

workbookName = Application.ThisWorkbook.Name
Set checkLocked = Application.Workbooks(workbookName)
  
If checkLocked.VBProject.Protection = 1 Then
    MsgBox "Erreur: VBE est protégé!", vbCritical, "Information!"
    If Not checkLocked Is Nothing Then Set checkLocked = Nothing
    Exit Sub
End If

usfName = Me.TextBox2.Text

If Not usfExists(usfName) = True Then MsgBox "Ce nom de UserForm n'existe pas ou est introuvable!", vbExclamation, "Information!": Exit Sub

strText = Split(Me.TextBox1.Text, vbCrLf)
j = Me.Label1.Caption

On Error Resume Next
For i = 0 To j
    code = code & strText(i) & vbCrLf
Next i

ProcName = strText(0)
On Error GoTo 0

If ProcName = "" Then MsgBox "première ligne de la macro sans données!", vbCritical, "Information!": Exit Sub

Debug.Print ProcName

s = ProcName
s = VBA.Left(s, VBA.InStr(s, " ") - 1)
Debug.Print s

If checkWords(s, "Private", "Public") Then
    ' is ok
Else
    ' wrong data
    MsgBox "première ligne de la macro avec des erreurs, elle doit commencer par le mot (Private ou Public)!", vbCritical, "Information!"
    Exit Sub
End If

s = ProcName
Debug.Print s

firstChar = InStr(s, "Sub") + 4
secondChar = InStr(firstChar, s, "(")

count = (secondChar - firstChar)

s = VBA.Mid(s, firstChar, count)
Debug.Print s

If Not checkMacroName(usfName, s) = True Then
    ' NO exists
Else
    ' name exists
    MsgBox "le nom de la macro existe déjà dans le module userform!", vbCritical, "Information!"
    Exit Sub
End If

With ThisWorkbook.VBProject.VBComponents(usfName).CodeModule
    NextLine = .CountOfLines + 1
    .InsertLines NextLine, code
End With

MsgBox "nouveau code ajouté!", vbInformation, "Information!"

End Sub

Private Sub TextBox1_Change()

Me.Label1.Caption = Me.TextBox1.LineCount

End Sub

Public Function checkMacroName(MyModuleName As String, MySub As String) As Boolean '

Dim MyModule As Object
Dim MyLine As Long
  
Set MyModule = ActiveWorkbook.VBProject.VBComponents(MyModuleName).CodeModule
On Error Resume Next
MyLine = MyModule.ProcStartLine(MySub, vbext_pk_Proc)

If Err.Number <> 0 Then ' error
    checkMacroName = False
Else
    checkMacroName = True
End If
  
Set MyModule = Nothing

End Function

Public Function checkWords(s As String, ParamArray xCompare()) As Boolean

Dim i As Long

For i = 0 To UBound(xCompare)
    If s = xCompare(i) Then
        checkWords = True
        Exit Function
    End If
Next i

checkWords = False

End Function

Bonjour,
j'ai tout mis dans le même Userform en suivant ton exemple mais ça n'affiche toujours pas mes userform alors que dans ton exemple ça fonctionne. Je vous mais mon fichier si jamais quelqu'un à le temps de jeter un coup d'oeil.

Rhysand · 20 Novembre 2020

Bonsoir à tous

Je viens de jeter un coup d'œil à votre projet

dans le code qui se trouve dans le module, vous avez ces déclarations de variables, donc l'écriture ne définit pas des objets, mais des variantes

exemple:
Dim Obj80, Obj99, Obj110 As MSForms.Label
équivaut à avoir:
Dim Obj80 As Variant, Obj99 As Variant, Obj110 As MSForms.Label

VB:

Dim Obj1, Obj2, Obj5, Obj7, Obj9, Obj11, Obj12, Obj14, Obj16, Obj18, Obj20, Obj22, Obj24 As MSForms.Label
Dim Obj26, Obj27, Obj33, Obj39, Obj40, Obj41, Obj42, Obj43, Obj44, Obj50, Obj61, Obj68, Obj70 As MSForms.Label
Dim Obj80, Obj99, Obj110 As MSForms.Label
Dim obj3, obj6 As MSForms.OptionButton
Dim obj4, obj8, obj10, obj13, obj15, obj17, obj19, obj25, obj34, obj35, obj36, obj37, obj38 As MSForms.TextBox
Dim obj51, obj52, obj53, obj54, obj55, obj62, obj63, obj64, obj65, obj66, obj69 As MSForms.TextBox
Dim obj81, obj82, obj83, obj84, obj85, obj86, obj87, obj88, obj89 As MSForms.TextBox
Dim obj100, obj101, obj102, obj103, obj104, obj105, obj106, obj107, obj108, obj111 As MSForms.TextBox
Dim obj21, obj23, obj56, obj57, obj58, obj59, obj60 As MSForms.ComboBox
Dim obj90, obj91, obj92, obj93, obj94, obj95, obj96, obj97, obj98 As MSForms.ComboBox
Dim obj28, obj29, obj30, obj31, obj32, obj45, obj46, obj47, obj48, obj49, obj67 As MSForms.CheckBox
Dim obj71, obj72, obj73, obj74, obj75, obj76, obj77, obj78, obj79, obj109 As MSForms.CheckBox
Dim obj112 As MSForms.CommandButton

le code pour fonctionner, ce serait au moins quelque chose de similaire à ce qui suit

VB:

Dim Obj1 As MSForms.Label, Obj2 As MSForms.Label, Obj5 As MSForms.Label, Obj7 As MSForms.Label, Obj9 As MSForms.Label
Dim Obj11 As MSForms.Label, Obj12 As MSForms.Label, Obj14 As MSForms.Label, Obj16 As MSForms.Label, Obj18 As MSForms.Label
Dim Obj20 As MSForms.Label, Obj22 As MSForms.Label, Obj24 As MSForms.Label, Obj26 As MSForms.Label, Obj27 As MSForms.Label
Dim Obj33 As MSForms.Label, Obj39 As MSForms.Label, Obj40 As MSForms.Label, Obj41 As MSForms.Label, Obj42 As MSForms.Label
Dim Obj43 As MSForms.Label, Obj44 As MSForms.Label, Obj50 As MSForms.Label, Obj61 As MSForms.Label, Obj68 As MSForms.Label
Dim Obj70 As MSForms.Label, Obj80 As MSForms.Label, Obj99 As MSForms.Label, Obj110 As MSForms.Label

Dim obj3 As MSForms.OptionButton, obj6 As MSForms.OptionButton

Dim obj4 As MSForms.TextBox, obj8 As MSForms.TextBox, obj10 As MSForms.TextBox, obj13 As MSForms.TextBox, obj15 As MSForms.TextBox, obj17 As MSForms.TextBox, obj19 As MSForms.TextBox, obj25 As MSForms.TextBox, obj34 As MSForms.TextBox, obj35 As MSForms.TextBox, obj36 As MSForms.TextBox, obj37 As MSForms.TextBox, obj38 As MSForms.TextBox
Dim obj51 As MSForms.TextBox, obj52 As MSForms.TextBox, obj53 As MSForms.TextBox, obj54 As MSForms.TextBox, obj55 As MSForms.TextBox, obj62 As MSForms.TextBox, obj63 As MSForms.TextBox, obj64 As MSForms.TextBox, obj65 As MSForms.TextBox, obj66 As MSForms.TextBox, obj69 As MSForms.TextBox
Dim obj81 As MSForms.TextBox, obj82 As MSForms.TextBox, obj83 As MSForms.TextBox, obj84 As MSForms.TextBox, obj85 As MSForms.TextBox, obj86 As MSForms.TextBox, obj87 As MSForms.TextBox, obj88 As MSForms.TextBox, obj89 As MSForms.TextBox
Dim obj100 As MSForms.TextBox, obj101 As MSForms.TextBox, obj102 As MSForms.TextBox, obj103 As MSForms.TextBox, obj104 As MSForms.TextBox, obj105 As MSForms.TextBox, obj106 As MSForms.TextBox, obj107 As MSForms.TextBox, obj108 As MSForms.TextBox, obj111 As MSForms.TextBox

Dim obj21 As MSForms.ComboBox, obj23 As MSForms.ComboBox, obj56 As MSForms.ComboBox, obj57 As MSForms.ComboBox, obj58 As MSForms.ComboBox, obj59 As MSForms.ComboBox, obj60 As MSForms.ComboBox
Dim obj90 As MSForms.ComboBox, obj91 As MSForms.ComboBox, obj92 As MSForms.ComboBox, obj93 As MSForms.ComboBox, obj94 As MSForms.ComboBox, obj95 As MSForms.ComboBox, obj96 As MSForms.ComboBox, obj97 As MSForms.ComboBox, obj98 As MSForms.ComboBox

Dim obj28 As MSForms.CheckBox, obj29 As MSForms.CheckBox, obj30 As MSForms.CheckBox, obj31 As MSForms.CheckBox, obj32 As MSForms.CheckBox, obj45 As MSForms.CheckBox, obj46 As MSForms.CheckBox, obj47 As MSForms.CheckBox, obj48 As MSForms.CheckBox, obj49 As MSForms.CheckBox, obj67 As MSForms.CheckBox
Dim obj71 As MSForms.CheckBox, obj72 As MSForms.CheckBox, obj73 As MSForms.CheckBox, obj74 As MSForms.CheckBox, obj75 As MSForms.CheckBox, obj76 As MSForms.CheckBox, obj77 As MSForms.CheckBox, obj78 As MSForms.CheckBox, obj79 As MSForms.CheckBox, obj109 As MSForms.CheckBox
 
Dim obj112 As MSForms.CommandButton

en apportant ce changement à votre code, et en cliquant sur "execute the code", j'ai pu créer les formulaires utilisateur

Adrien60 · 20 Novembre 2020

Rhysand à dit:

Bonsoir à tous

Je viens de jeter un coup d'œil à votre projet

dans le code qui se trouve dans le module, vous avez ces déclarations de variables, donc l'écriture ne définit pas des objets, mais des variantes

exemple:
Dim Obj80, Obj99, Obj110 As MSForms.Label
équivaut à avoir:
Dim Obj80 As Variant, Obj99 As Variant, Obj110 As MSForms.Label

VB:

Dim Obj1, Obj2, Obj5, Obj7, Obj9, Obj11, Obj12, Obj14, Obj16, Obj18, Obj20, Obj22, Obj24 As MSForms.Label
Dim Obj26, Obj27, Obj33, Obj39, Obj40, Obj41, Obj42, Obj43, Obj44, Obj50, Obj61, Obj68, Obj70 As MSForms.Label
Dim Obj80, Obj99, Obj110 As MSForms.Label
Dim obj3, obj6 As MSForms.OptionButton
Dim obj4, obj8, obj10, obj13, obj15, obj17, obj19, obj25, obj34, obj35, obj36, obj37, obj38 As MSForms.TextBox
Dim obj51, obj52, obj53, obj54, obj55, obj62, obj63, obj64, obj65, obj66, obj69 As MSForms.TextBox
Dim obj81, obj82, obj83, obj84, obj85, obj86, obj87, obj88, obj89 As MSForms.TextBox
Dim obj100, obj101, obj102, obj103, obj104, obj105, obj106, obj107, obj108, obj111 As MSForms.TextBox
Dim obj21, obj23, obj56, obj57, obj58, obj59, obj60 As MSForms.ComboBox
Dim obj90, obj91, obj92, obj93, obj94, obj95, obj96, obj97, obj98 As MSForms.ComboBox
Dim obj28, obj29, obj30, obj31, obj32, obj45, obj46, obj47, obj48, obj49, obj67 As MSForms.CheckBox
Dim obj71, obj72, obj73, obj74, obj75, obj76, obj77, obj78, obj79, obj109 As MSForms.CheckBox
Dim obj112 As MSForms.CommandButton

le code pour fonctionner, ce serait au moins quelque chose de similaire à ce qui suit

VB:

Dim Obj1 As MSForms.Label, Obj2 As MSForms.Label, Obj5 As MSForms.Label, Obj7 As MSForms.Label, Obj9 As MSForms.Label
Dim Obj11 As MSForms.Label, Obj12 As MSForms.Label, Obj14 As MSForms.Label, Obj16 As MSForms.Label, Obj18 As MSForms.Label
Dim Obj20 As MSForms.Label, Obj22 As MSForms.Label, Obj24 As MSForms.Label, Obj26 As MSForms.Label, Obj27 As MSForms.Label
Dim Obj33 As MSForms.Label, Obj39 As MSForms.Label, Obj40 As MSForms.Label, Obj41 As MSForms.Label, Obj42 As MSForms.Label
Dim Obj43 As MSForms.Label, Obj44 As MSForms.Label, Obj50 As MSForms.Label, Obj61 As MSForms.Label, Obj68 As MSForms.Label
Dim Obj70 As MSForms.Label, Obj80 As MSForms.Label, Obj99 As MSForms.Label, Obj110 As MSForms.Label

Dim obj3 As MSForms.OptionButton, obj6 As MSForms.OptionButton

Dim obj4 As MSForms.TextBox, obj8 As MSForms.TextBox, obj10 As MSForms.TextBox, obj13 As MSForms.TextBox, obj15 As MSForms.TextBox, obj17 As MSForms.TextBox, obj19 As MSForms.TextBox, obj25 As MSForms.TextBox, obj34 As MSForms.TextBox, obj35 As MSForms.TextBox, obj36 As MSForms.TextBox, obj37 As MSForms.TextBox, obj38 As MSForms.TextBox
Dim obj51 As MSForms.TextBox, obj52 As MSForms.TextBox, obj53 As MSForms.TextBox, obj54 As MSForms.TextBox, obj55 As MSForms.TextBox, obj62 As MSForms.TextBox, obj63 As MSForms.TextBox, obj64 As MSForms.TextBox, obj65 As MSForms.TextBox, obj66 As MSForms.TextBox, obj69 As MSForms.TextBox
Dim obj81 As MSForms.TextBox, obj82 As MSForms.TextBox, obj83 As MSForms.TextBox, obj84 As MSForms.TextBox, obj85 As MSForms.TextBox, obj86 As MSForms.TextBox, obj87 As MSForms.TextBox, obj88 As MSForms.TextBox, obj89 As MSForms.TextBox
Dim obj100 As MSForms.TextBox, obj101 As MSForms.TextBox, obj102 As MSForms.TextBox, obj103 As MSForms.TextBox, obj104 As MSForms.TextBox, obj105 As MSForms.TextBox, obj106 As MSForms.TextBox, obj107 As MSForms.TextBox, obj108 As MSForms.TextBox, obj111 As MSForms.TextBox

Dim obj21 As MSForms.ComboBox, obj23 As MSForms.ComboBox, obj56 As MSForms.ComboBox, obj57 As MSForms.ComboBox, obj58 As MSForms.ComboBox, obj59 As MSForms.ComboBox, obj60 As MSForms.ComboBox
Dim obj90 As MSForms.ComboBox, obj91 As MSForms.ComboBox, obj92 As MSForms.ComboBox, obj93 As MSForms.ComboBox, obj94 As MSForms.ComboBox, obj95 As MSForms.ComboBox, obj96 As MSForms.ComboBox, obj97 As MSForms.ComboBox, obj98 As MSForms.ComboBox

Dim obj28 As MSForms.CheckBox, obj29 As MSForms.CheckBox, obj30 As MSForms.CheckBox, obj31 As MSForms.CheckBox, obj32 As MSForms.CheckBox, obj45 As MSForms.CheckBox, obj46 As MSForms.CheckBox, obj47 As MSForms.CheckBox, obj48 As MSForms.CheckBox, obj49 As MSForms.CheckBox, obj67 As MSForms.CheckBox
Dim obj71 As MSForms.CheckBox, obj72 As MSForms.CheckBox, obj73 As MSForms.CheckBox, obj74 As MSForms.CheckBox, obj75 As MSForms.CheckBox, obj76 As MSForms.CheckBox, obj77 As MSForms.CheckBox, obj78 As MSForms.CheckBox, obj79 As MSForms.CheckBox, obj109 As MSForms.CheckBox

Dim obj112 As MSForms.CommandButton

en apportant ce changement à votre code, et en cliquant sur "execute the code", j'ai pu créer les formulaires utilisateur

Regarde la pièce jointe 1085570

Bonjour, merci d'avoir jeter un coup d'oeil mais comme je l'ai dit plus haut, je n'ai pas de problème quand à la création des userforms que ce soit avec :
dim obj1,obj2 as Msforms..... ou dim obj1 as Msforms....., obj2 as MsForms.....
les userforms se créent bien mais impossible de les affichés à l'écran en lançant toute la procédure.

Rhysand · 20 Novembre 2020

Bonjour à tous

votre projet a demandé du travail
beaucoup d'erreurs

J'ai adapté quelques changements

fichier Excel joint

Adrien60 · 20 Novembre 2020

Rhysand à dit:
Bonjour à tous

votre projet a demandé du travail
beaucoup d'erreurs

J'ai adapté quelques changements

fichier Excel joint

Merci beaucoup pour le temps passer sur mon projet. Tout fonctionne, il me reste a comprendre toutes les subtilités avant d'avancer plus loin.

Microsoft 365 Problème affichage userform après insertion du code

Adrien60

XLDnaute Nouveau

Rhysand

Phil69970

XLDnaute Barbatruc

Adrien60

XLDnaute Nouveau

Phil69970

XLDnaute Barbatruc

Adrien60

XLDnaute Nouveau

Rhysand

XLDnaute Junior

Adrien60

XLDnaute Nouveau

Pièces jointes

Rhysand

XLDnaute Junior

Pièces jointes

Adrien60

XLDnaute Nouveau

Rhysand

XLDnaute Junior

Pièces jointes

Adrien60

XLDnaute Nouveau

Discussions similaires