UserForm ne fonctionne qu'une fois - message erreur 9

Le 13/01/2018 à 19:44

Bonjour à tous,

J'ai un problème de codage assez étrange.

J'ai un userform1 (accueil pour l'utilisateur) qui me permets à l'aide de bouton d'accéder à d'autre userforms (par exemple userform2).

1) Lorsque je charge le userform2 tout fonctionne bien (le userform1 se cache et le userform2 affiche ce qu'il doit afficher => les données d'un classeur excel via une spreadsheet).

2) Je décharge le userform2 à l'aide d'un bouton et fait apparaître de nouveau le userform1 (interface d'acceuil).

3) Si je souhaite de nouveau faire apparaître le userform2 c'est là que ça plante avec le message d'erreur.

Remarque : c'est le cas pour tous mes userform(2,3,4,5) => le premier chargement nickel mais une fois déchargé il n'y a plus moyen de les faire apparaître de nouveau.

Je vous joins les codes de uerform1 :

Private Declare Function GetSystemMenu _
    Lib "user32" ( _
    ByVal hWnd As Long, _
    ByVal bRevert As Long) _
As Long

Private Declare Function RemoveMenu _
    Lib "user32" ( _
    ByVal hMenu As Long, _
    ByVal nPosition As Long, _
    ByVal wFlags As Long) _
As Long

Private Declare Function FindWindowA _
    Lib "user32" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) _
As Long

Private Const MF_BYPOSITION As Long = &H400
Private Sub UserForm_Initialize()
Dim lFrmHdl As Long, iCount As Integer
'// Ivan F Moala
lFrmHdl = FindWindowA(vbNullString, Me.Caption)

If lFrmHdl <> 0 Then
    '// MF_BYCOMMAND
    '//Indicates that uPosition gives the identifier of the menu item.

    '//If neither the MF_BYCOMMAND nor MF_BYPOSITION flag is specified,
    '//the MF_BYCOMMAND flag is the default flag.

    '// MF_BYPOSITION
    '//Indicates that uPosition gives the zero-based relative position of the menu item.
    '// ie 0,1,2,3 etc
    'Exit Sub
    '//Typical Windows has 6 menus
    '//Restore, Move, Size, Minimise, Maximize, Close
    '//Even though a Userform displays 2 = Move & Close
    '//By default Move is the Next item
    '//so just loop twice
    For iCount = 0 To 1
        RemoveMenu GetSystemMenu(lFrmHdl, False), 0, MF_BYPOSITION
    Next iCount
End If

End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
MsgBox "Vous ne pouvez pas utiliser ce bouton de fermeture." & Chr(10) _
& "Pour quitter le logiciel, veuillez utiliser le bouton prévu à cet effet"
Cancel = True
End If
End Sub

Private Sub ComboBox1_Change()
Dim WB As Workbook

For Each WB In Workbooks
If (WB.Name <> "LAST_SOFT.xls") = True Then
WB.Close SaveChanges:=False
End If
Next

    If ComboBox1.Value = "TRANCHE 4" Then
        Set WB = Workbooks.Open("\\Atlas.edf.fr\co\45dam-dpn\services.006\sco.001\Exp34\0 Equipe F\Maxime\LAST\LAST_TR4.xls")
        WB.Activate

    ElseIf ComboBox1.Value = "TRANCHE 2" Then
        Set WB = Workbooks.Open("\\Atlas.edf.fr\co\45dam-dpn\services.006\sco.001\Exp34\0 Equipe F\Maxime\LAST\LAST_TR2.xls")
        WB.Activate

    ElseIf ComboBox1.Value = "TRANCHE 1" Then
        Set WB = Workbooks.Open("\\Atlas.edf.fr\co\45dam-dpn\services.006\sco.001\Exp34\0 Equipe F\Maxime\LAST\LAST_TR1.xls")
        WB.Activate

    ElseIf ComboBox1.Value = "TRANCHE 3" Then
        Set WB = Workbooks.Open("\\Atlas.edf.fr\co\45dam-dpn\services.006\sco.001\Exp34\0 Equipe F\Maxime\LAST\LAST_TR3.xls")
        WB.Activate

    End If

    UserForm6.Show

End Sub

Private Sub CommandButton1_Click()
Me.Hide
UserForm2.Show
End Sub

Private Sub CommandButton2_Click()
Me.Hide
UserForm4.Show
End Sub

Private Sub CommandButton3_Click()
Me.Hide
UserForm5.Show
End Sub

Private Sub CommandButton4_Click()
ActiveWorkbook.Close SaveChanges:=False
ThisWorkbook.Close SaveChanges:=False
Application.Quit
Application.DisplayAlerts = True
End Sub

Private Sub CommandButton5_Click()
UserForm3.Show
End Sub

Private Sub CommandButton6_Click()
UserForm7.Show
End Sub

Et le code de UserForm2:

Private Sub CommandButton1_Click()
Unload UserForm2
UserForm1.Show
End Sub

Private Sub CommandButton172_Click()

Unload UserForm2

Dim WB As Workbook

For Each WB In Workbooks
If (WB.Name <> "LAST_SOFT.xls") = True Then
WB.Close SaveChanges:=False
End If
Next

    If UserForm1.ComboBox1.Value = "TRANCHE 4" Then
        Set WB = Workbooks.Open("\\Atlas.edf.fr\co\45dam-dpn\services.006\sco.001\Exp34\0 Equipe F\Maxime\LAST\LAST_TR4.xls")
        WB.Activate

    ElseIf UserForm1.ComboBox1.Value = "TRANCHE 2" Then
        Set WB = Workbooks.Open("\\Atlas.edf.fr\co\45dam-dpn\services.006\sco.001\Exp34\0 Equipe F\Maxime\LAST\LAST_TR2.xls")
        WB.Activate

    ElseIf UserForm1.ComboBox1.Value = "TRANCHE 1" Then
        Set WB = Workbooks.Open("\\Atlas.edf.fr\co\45dam-dpn\services.006\sco.001\Exp34\0 Equipe F\Maxime\LAST\LAST_TR1.xls")
        WB.Activate

    ElseIf UserForm1.ComboBox1.Value = "TRANCHE 3" Then
        Set WB = Workbooks.Open("\\Atlas.edf.fr\co\45dam-dpn\services.006\sco.001\Exp34\0 Equipe F\Maxime\LAST\LAST_TR3.xls")
        WB.Activate

    End If

    UserForm6.Show
    UserForm2.Show

End Sub

Private Sub CommandButton2_Click()
Unload UserForm2
UserForm3.Show
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
MsgBox "Vous ne pouvez pas utiliser ce bouton de fermeture." & Chr(10) _
& "Pour revenir au menu principal, veuillez utiliser le bouton prévu à cet effet"
Cancel = True
End If
End Sub
Private Sub UserForm_Initialize()
Dim R As Range
Dim SP As Object
Dim SHSP As Object
Dim RSP As Object
Dim Ctrl As Control
Dim i As Integer

i = 1
For Each Ctrl In Controls
If i <= 34 Then
Me.MultiPage1.Pages(i - 1).Caption = ActiveWorkbook.Sheets(i + 1).Cells(2, 2).Value
If TypeName(Ctrl) = "Spreadsheet" Then
Set R = ActiveWorkbook.Sheets(i + 1).Range("a1:z100")
R.Copy
Set SP = Ctrl.Object
Set SHSP = SP.Worksheets(1)
Set RSP = SHSP.[a1]
RSP.Select
SHSP.Paste
RSP.Select
Application.CutCopyMode = False
SP.DisplayTitleBar = False
SP.DisplayToolbar = False

Ctrl.Object.Worksheets("Feuil1").Columns(3).AutoFit
Ctrl.Object.Worksheets("Feuil1").Columns(8).AutoFit
Ctrl.Object.Worksheets("Feuil1").Columns(13).AutoFit
Ctrl.Object.Worksheets("Feuil1").Columns(18).AutoFit
Ctrl.Object.Worksheets("Feuil1").Columns(23).AutoFit

Ctrl.Object.Worksheets("Feuil1").Columns(2).AutoFit
Ctrl.Object.Worksheets("Feuil1").Columns(7).AutoFit
Ctrl.Object.Worksheets("Feuil1").Columns(12).AutoFit
Ctrl.Object.Worksheets("Feuil1").Columns(17).AutoFit
Ctrl.Object.Worksheets("Feuil1").Columns(22).AutoFit

Ctrl.Object.Worksheets("Feuil1").Columns(4).AutoFit
Ctrl.Object.Worksheets("Feuil1").Columns(9).AutoFit
Ctrl.Object.Worksheets("Feuil1").Columns(14).AutoFit
Ctrl.Object.Worksheets("Feuil1").Columns(19).AutoFit
Ctrl.Object.Worksheets("Feuil1").Columns(24).AutoFit

Ctrl.Object.Worksheets("Feuil1").Columns(1).ColumnWidth = 4
Ctrl.Object.Worksheets("Feuil1").Columns(6).ColumnWidth = 4
Ctrl.Object.Worksheets("Feuil1").Columns(11).ColumnWidth = 4
Ctrl.Object.Worksheets("Feuil1").Columns(16).ColumnWidth = 4
Ctrl.Object.Worksheets("Feuil1").Columns(21).ColumnWidth = 4
Ctrl.Object.Worksheets("Feuil1").Columns(26).ColumnWidth = 4

Ctrl.Object.Worksheets("Feuil1").Columns(5).ColumnWidth = 5
Ctrl.Object.Worksheets("Feuil1").Columns(10).ColumnWidth = 5
Ctrl.Object.Worksheets("Feuil1").Columns(15).ColumnWidth = 5
Ctrl.Object.Worksheets("Feuil1").Columns(20).ColumnWidth = 5
Ctrl.Object.Worksheets("Feuil1").Columns(25).ColumnWidth = 5

Dim j As Integer
For j = 1 To 110
If Ctrl.Object.Worksheets("Feuil1").Cells(j, 6).Text = "0" Then
Ctrl.Object.Worksheets("Feuil1").Cells(j, 4).Font.ColorIndex = 10
ElseIf Ctrl.Object.Worksheets("Feuil1").Cells(j, 6).Text = "1" Then
Ctrl.Object.Worksheets("Feuil1").Cells(j, 4).Font.ColorIndex = 3
End If
If Ctrl.Object.Worksheets("Feuil1").Cells(j, 11).Text = "0" Then
Ctrl.Object.Worksheets("Feuil1").Cells(j, 9).Font.ColorIndex = 10
ElseIf Ctrl.Object.Worksheets("Feuil1").Cells(j, 11).Text = "1" Then
Ctrl.Object.Worksheets("Feuil1").Cells(j, 9).Font.ColorIndex = 3
End If
If Ctrl.Object.Worksheets("Feuil1").Cells(j, 16).Text = "0" Then
Ctrl.Object.Worksheets("Feuil1").Cells(j, 14).Font.ColorIndex = 10
ElseIf Ctrl.Object.Worksheets("Feuil1").Cells(j, 16).Text = "1" Then
Ctrl.Object.Worksheets("Feuil1").Cells(j, 14).Font.ColorIndex = 3
End If
If Ctrl.Object.Worksheets("Feuil1").Cells(j, 21).Text = "0" Then
Ctrl.Object.Worksheets("Feuil1").Cells(j, 19).Font.ColorIndex = 10
ElseIf Ctrl.Object.Worksheets("Feuil1").Cells(j, 21).Text = "1,00" Then
Ctrl.Object.Worksheets("Feuil1").Cells(j, 19).Font.ColorIndex = 3
End If
If Ctrl.Object.Worksheets("Feuil1").Cells(j, 26).Text = "0" Then
Ctrl.Object.Worksheets("Feuil1").Cells(j, 24).Font.ColorIndex = 10
ElseIf Ctrl.Object.Worksheets("Feuil1").Cells(j, 26).Text = "1" Then
Ctrl.Object.Worksheets("Feuil1").Cells(j, 24).Font.ColorIndex = 3
End If
Next
i = i + 1
End If
End If
Next
End Sub

Je précise que la propriété ShowModal de mes deux UserForms est False. (je sais que c'est un point de questionnement récurrent dans ce genre de problème).

Merci d'avance pour vos idées et votre aide !

Le 13/01/2018 à 23:43

Bonjour,

ta variable i as Integer (i = 1) me semble trop bizarre et mal placer vers la fin enfin c'est ce que je pense, attend la réponse d'un professionnel d'Excel

next i

puis vers la fin next i+1

crdlt,

André

Rechercher des sujets similaires à "userform fonctionne fois message erreur"