Userform ne se ferme pas

[Cougar]

Bonsoir,

Mon userform va bien seulement si je rempli 10 combobox (environ 10 sec). Si je rempli les 20 combobox rien ne passe, même après 5 min. (il ne se ferme pas)???

Quelqu'un aurait une idée du pourquoi ?

Voir le fichier joint

Merci

 

[Grand Chaman Excel]

Re : Userform ne se ferme pas

Bonjour Cougar,

J'ai essayé en remplissant les 20 combobox et le userform s'est fermé après quelques secondes (~20).
Tu pourrais optimiser ton code en enlever tout les .Select et les .Activate (inutile et ça ralenti le code). Tu as aussi plusieurs boucle (Goto X). Il y a peut-être des cas où ça tourne en rond ??

Pour voir où ton code prend du temps ou bloque, tu pourrais insérer dans ton code des "Application.StatusBar = "Je suis rendu ici..." ou des "Debug.Print "Je suis rendu là..."

Application.StatusBar écrit un message dans la barre en bas à gauche.
Debug.Print écrit dans le fenêtre exécution dans l'éditeur VBA (CTRL + G) pour afficher.

Parfois, ça peut être utile pour débugger...

A+

 

[camarchepas]

Re : Userform ne se ferme pas

Bonjour Grand chaman Excel , Cougar, oups j'avais pas rafraichit avant de te répondre , enfin le son de cloche est à peut près le même en fait :
Bon , j'ai fait un test en remplissant tout , cela fonctionne , même si c'est très long

Code un peu austére , même si il fonctionne , je pense que sur un grand nombre de données il est complétement inéfficace.

Enfin cela dit, j'ai constaté l'utilisation de goto xxx, source de boucle sans fin potentielle.

Bon en principe avec des points d'arrêt , et le bon jeu de données , tu dévrais vite voir ou cela boucle.

Autre solution , le tracage dans la barre status avec un ajout d'instruction application.statusbar = "Suite" devant goto suite et idem pour tous les goto.

Connais tu l'instruction de recherche find, qui serait surement plus performante et permettrait de gagner un certain nombre de boucles.

 

[Cougar]

Re : Userform ne se ferme pas

Bonjour vous deux,

Je ne connais aucune des fonctions que vous parler. Je vais utiliser le menu aide pour vous comme le tout peut m'aider. 🙂

Merci

 

[Staple1600]

Re : Userform ne se ferme pas

Bonjour à tous

Juste pour signaler que nos cousins du Quebec n'hésitent pas d'emblée à caresser la touche F1 (qui affiche l'aide)
Ça fait plaisir 😉

Pour le reste, une petite question, Cougar:
Quel est ton niveau de maîtrise du VBA?

PS: Si ton code VBA n'est pas trop long, peux-tu le publier directement dans le corps de ton message?
Je dis cela parce qu'aujourd'hui je risque fort d'être sur un PC sans Excel.

 

[Cougar]

Re : Userform ne se ferme pas

Bonjour Staple1600, voici le code. Étant début, j'apprécie ton aide. Merci

Dim t As Variant, i As Byte, y As Byte, z As Byte
Private Sub CommandButton1_Click()

Application.ScreenUpdating = False

Worksheets("Commandes Stinson").Activate
With Sheets("Commandes Stinson")

If TextBox41 = "" Then
If MsgBox("ENTRER UNE DATE ?", vbYesNo + vbQuestion, "Avertissement : ajouter une date ?") = vbYes Then Exit Sub
MsgBox "IL FAUT ENTRER UNE DATE POUR CONTINER ?", vbExclamation, "ERREUR ... Rien ne sera ajouté"
Exit Sub
End If

Range("c1").Select
Range(ActiveCell, ActiveCell.Offset(400)).Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("c1").Select
ActiveCell.FormulaR1C1 = "Date et quantité commandée"

Selection.Merge
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveCell.RowHeight = 68
Range(ActiveCell, ActiveCell.Offset(400)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

ActiveCell.Offset(3, 0).Select

y = 1
For i = 1 To 20
If Controls("ComboBox" & i).ListIndex - 1 Then
.Cells(Controls("ComboBox" & i).ListIndex + 3, 3) = Controls("Textbox" & y).Value
y = y + 1
End If
Next i
End With

Range("c2").Select
ActiveCell.Value = TextBox41.Value
Range("c3").Value = ("INT # " & TextBox42.Value)
With Sheets("Matières premières").Select
Range("d:e").Select
With Selection
Selection.Insert Shift:=xlToRight
End With

Sheets("Commandes Stinson").Select
Range("C2:C3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Matières premières").Select
Range("D1").Select
ActiveSheet.Paste
Columns("D😀").EntireColumn.AutoFit
Range("D3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Besoin"
End With

With Sheets("Commandes Stinson").Select
Range("c4").Activate

Suite1:
If ActiveCell = "" And ActiveCell.Offset(0, -2) = "" Then
GoTo Trier
Else
If ActiveCell <> "" Then
maQuantité = ActiveCell.Value
monProduit = ActiveCell.Offset(0, -2).Value
ActiveCell.Offset(1, 0).Select
GoTo Quantité_matière
Else
ActiveCell.Offset(1, 0).Activate
End If
GoTo Suite1
End If

Quantité_matière:
With Sheets("Produits").Activate
Range("b1").Activate
Do Until ActiveCell = monProduit
ActiveCell.Offset(0, 1).Activate
Loop
ActiveCell.Offset(2, 0).Activate
maComposante = ActiveCell.Value
monBesoin = ActiveCell.Offset(0, 1).Value

Vérification_inventaire:
With Sheets("Matières Premières").Activate
Range("A4").Activate

Do Until ActiveCell = ""
Do Until ActiveCell = maComposante
If ActiveCell.Value = "" Then Exit Sub
ActiveCell.Offset(1, 0).Activate
Loop
If ActiveCell = maComposante Then
ActiveCell.Offset(0, 3).Value = ActiveCell.Offset(0, 3) + (monBesoin * maQuantité)

With Sheets("Produits").Activate
If ActiveCell.Value = "" Then
GoTo Suite
Else
ActiveCell.Offset(1, 0).Activate
If ActiveCell <> "" Then
maComposante = ActiveCell.Value
monBesoin = ActiveCell.Offset(0, 1)
Else
Worksheets("Commandes Stinson").Select
GoTo Suite1
End If
End If
End With
End If
GoTo Vérification_inventaire
Loop
End With
End With
End With

Suite:
With Sheets("Commandes Stinson").Select

If ActiveCell.Value <> "" Then
maComposante = ActiveCell.Value
ActiveCell.Offset(0, 1).Activate
monBesoin = ActiveCell.Value
Else
ActiveCell.Offset(1, 2).Activate
If ActiveCell = "" Then
ActiveCell.Offset(1, 0).Select
If ActiveCell.Offset(0, -2).Value = "" Then
End If
End If

Do Until ActiveCell = ""
monProduit = ActiveCell
ActiveCell.Offset(0, 2).Select
If ActiveCell = "" Then
Else
maQuantité = ActiveCell.Value
End If
Loop
End If
End With

Trier:
With Sheets("Matières Premières").Select

Range("E:E,G:G,I:I,K:K,M:M,O:O,Q:Q,S:S,U:U,W:W,Y:Y,AA:AA").Delete

ActiveWorkbook.Worksheets("Matières Premières").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Matières Premières").Sort.SortFields.Add Key:=Range _
("d1:t1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Matières Premières").Sort
.SetRange Range("d1:t300")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With

Range("E:E,F:F,G:G,H:H,I:I,J:J,K:K,L:L,M:M,N:N,O:O,P😛,Q:Q,R:R,S:S,U:U,W:W,Y:Y").Insert
Range("E:E,G:G,I:I,K:K,M:M,O:O,Q:Q,S:S,W:W").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
Formula1:="=0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority

With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False

Range("E4").Select

ActiveCell.FormulaR1C1 = "=RC[-2]-RC[-1]"
Selection.NumberFormat = "General"
Selection.Copy
Range(ActiveCell, ActiveCell.Offset(400)).Select
ActiveSheet.Paste
ActiveCell.Offset(-1, 0).Select
ActiveCell.FormulaR1C1 = "Reste"
ActiveCell.Offset(1, 2).Select

Range("e1").Select

For z = 1 To 20
Range(ActiveCell, ActiveCell.Offset(400)).Copy
ActiveCell.Offset(0, 2).Select
ActiveSheet.Paste
Next

Range("E4").Select

End With

'tri dates

Sheets("Commandes Stinson").Select
ActiveWorkbook.Worksheets("Commandes Stinson").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Commandes Stinson").Sort.SortFields.Add Key:=Range _
("C2:L2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Commandes Stinson").Sort
.SetRange Range("C1:L300")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With

Columns("C:V").ColumnWidth = 20

'cadrage

Range("C4:C138").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With

Range("Q:Z").Select
With Selection
Selection.Delete Shift:=xlToLeft
End With

Range("C1").Select

Fin:
Unload Me

 

[Staple1600]

Re : Userform ne se ferme pas

Bonsoir Cougar

Merci
Pour un commodité de lecture, tu peux utiliser les balises BBCODE CODE ou utiliser le bouton #
Cela te donnera ce genre d'affichage
Pour te récompenser de ta peine, permets que je fasse un peu le ménage dans ton code.
(Heureusement ce soir je suis sur un PC avec Excel)
Déjà on peut s'employer à supprimer la plupart des Select et Activate
Je vais cela après avoir préparer le diner et je te reposte un code plus digeste pendant que moi je serai en pleine digestion.
EDITION: Un contre-temps d'ordre familial a empêcher ce que je te promettais au dessus .
Mais ce n'est que partie remise.
Tu peux en attendant que je repasse* (ou que d'autres ici fassent ce petit toillettage de ton code) essayer de voir sur le forum différents exemples qui illustrent comment on peut se passer de Select et Activate.
*: je repasserai en fin d'aprés-midi demain (et peut-être rapidement demain matin)

Dim t As Variant, i As Byte, y As Byte, z As Byte
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Worksheets("Commandes Stinson").Activate
With Sheets("Commandes Stinson")
If TextBox41 = "" Then
If MsgBox("ENTRER UNE DATE ?", vbYesNo + vbQuestion, "Avertissement : ajouter une date ?") = vbYes Then Exit Sub
MsgBox "IL FAUT ENTRER UNE DATE POUR CONTINER ?", vbExclamation, "ERREUR ... Rien ne sera ajouté"
Exit Sub
End If


Range("c1").Offset(400)).Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("c1").Select
ActiveCell.FormulaR1C1 = "Date et quantité commandée"


Selection.Merge
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveCell.RowHeight = 68
Range(ActiveCell, ActiveCell.Offset(400)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With


ActiveCell.Offset(3, 0).Select


y = 1
For i = 1 To 20
If Controls("ComboBox" & i).ListIndex - 1 Then
.Cells(Controls("ComboBox" & i).ListIndex + 3, 3) = Controls("Textbox" & y).Value
y = y + 1
End If
Next i
End With


Range("c2").Select
ActiveCell.Value = TextBox41.Value
Range("c3").Value = ("INT # " & TextBox42.Value)
With Sheets("Matières premières").Select
Range("d:e").Select
With Selection
Selection.Insert Shift:=xlToRight
End With


Sheets("Commandes Stinson").Select
Range("C2:C3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Matières premières").Select
Range("D1").Select
ActiveSheet.Paste
Columns("D").EntireColumn.AutoFit
Range("D3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Besoin"
End With


With Sheets("Commandes Stinson").Select
Range("c4").Activate


Suite1:
If ActiveCell = "" And ActiveCell.Offset(0, -2) = "" Then
GoTo Trier
Else
If ActiveCell <> "" Then
maQuantité = ActiveCell.Value
monProduit = ActiveCell.Offset(0, -2).Value
ActiveCell.Offset(1, 0).Select
GoTo Quantité_matière
Else
ActiveCell.Offset(1, 0).Activate
End If
GoTo Suite1
End If


Quantité_matière:
With Sheets("Produits").Activate
Range("b1").Activate
Do Until ActiveCell = monProduit
ActiveCell.Offset(0, 1).Activate
Loop
ActiveCell.Offset(2, 0).Activate
maComposante = ActiveCell.Value
monBesoin = ActiveCell.Offset(0, 1).Value


Vérification_inventaire:
With Sheets("Matières Premières").Activate
Range("A4").Activate


Do Until ActiveCell = ""
Do Until ActiveCell = maComposante
If ActiveCell.Value = "" Then Exit Sub
ActiveCell.Offset(1, 0).Activate
Loop
If ActiveCell = maComposante Then
ActiveCell.Offset(0, 3).Value = ActiveCell.Offset(0, 3) + (monBesoin * maQuantité)


With Sheets("Produits").Activate
If ActiveCell.Value = "" Then
GoTo Suite
Else
ActiveCell.Offset(1, 0).Activate
If ActiveCell <> "" Then
maComposante = ActiveCell.Value
monBesoin = ActiveCell.Offset(0, 1)
Else
Worksheets("Commandes Stinson").Select
GoTo Suite1
End If
End If
End With
End If
GoTo Vérification_inventaire
Loop
End With
End With
End With


Suite:
With Sheets("Commandes Stinson").Select


If ActiveCell.Value <> "" Then
maComposante = ActiveCell.Value
ActiveCell.Offset(0, 1).Activate
monBesoin = ActiveCell.Value
Else
ActiveCell.Offset(1, 2).Activate
If ActiveCell = "" Then
ActiveCell.Offset(1, 0).Select
If ActiveCell.Offset(0, -2).Value = "" Then
End If
End If


Do Until ActiveCell = ""
monProduit = ActiveCell
ActiveCell.Offset(0, 2).Select
If ActiveCell = "" Then
Else
maQuantité = ActiveCell.Value
End If
Loop
End If
End With


Trier:
With Sheets("Matières Premières").Select


Range("E:E,G:G,I:I,K:K,M:M,O:O,Q:Q,S:S,U:U,W:W,Y:Y ,AA:AA").Delete


ActiveWorkbook.Worksheets("Matières Premières").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Matières Premières").Sort.SortFields.Add Key:=Range _
("d1:t1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Matières Premières").Sort
.SetRange Range("d1:t300")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With


Range("E:E,F:F,G:G,H:H,I:I,J:J,K:K,L:L,M:M,N:N,O:O ,P:P,Q:Q,R:R,S:S,U:U,W:W,Y:Y").Insert
Range("E:E,G:G,I:I,K:K,M:M,O:O,Q:Q,S:S,W:W").Selec t
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
Formula1:="=0"
Selection.FormatConditions(Selection.FormatConditi ons.Count).SetFirstPriority


With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False


Range("E4").Select


ActiveCell.FormulaR1C1 = "=RC[-2]-RC[-1]"
Selection.NumberFormat = "General"
Selection.Copy
Range(ActiveCell, ActiveCell.Offset(400)).Select
ActiveSheet.Paste
ActiveCell.Offset(-1, 0).Select
ActiveCell.FormulaR1C1 = "Reste"
ActiveCell.Offset(1, 2).Select


Range("e1").Select


For z = 1 To 20
Range(ActiveCell, ActiveCell.Offset(400)).Copy
ActiveCell.Offset(0, 2).Select
ActiveSheet.Paste
Next


Range("E4").Select


End With


'tri dates


Sheets("Commandes Stinson").Select
ActiveWorkbook.Worksheets("Commandes Stinson").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Commandes Stinson").Sort.SortFields.Add Key:=Range _
("C2:L2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Commandes Stinson").Sort
.SetRange Range("C1:L300")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With

Columns("C:V").ColumnWidth = 20

'cadrage
'Range("C4:C138").
' on verra le cadrage plus tard ;-)

Range("Q:Z").Delete Shift:=xlToLeft
Range("C1").Select

Fin:
Unload Me
End Sub

 

[Cougar]

Re : Userform ne se ferme pas

Bonjour Staple1600,

Moi je vais essayer de digérer ces nouvelles fonctions pour que le VBA soit, pour moi, moins indigeste. 🙂

J'apprécie ton aide.

Merci

 

[STephane]

Re : Userform ne se ferme pas

Tu as utilisé étiquettes pour aller à certains endroits de la procédure et revenir, ce n'est pas vraiment approprié là. Pour plus de clartés, tu peux plutôt prévoir des sous-procédures. Tu t'en es également servir pour boucler sur les lignes renseignées. Ce sont des choses expliquant je crois la lenteur.

J'ai réécrit beaucoup de choses, en espérant avoir compris ce que tu cherchais à faire.
Pour information, je n'ai pas réinclus le tri (et donc les bordures).

Code à mettre dans un module

'---------------------------------------------------------------------------------------
' Module    : Module1
' Author    : XLD
' Date      : Mercredi 05 Décembre 2012
' Purpose   : http://www.excel-downloads.com/forum/197028-userform-ne-se-ferme-pas.html
'---------------------------------------------------------------------------------------
'
' Procedures : <<
'   Z_Borders
'   Z_Trier
'   Z_Prepare_Commande
'   Z_Sauvegarde_Commande
'   Z_CommandeExiste
'   Z_CommandeBienSaisie
' >>
'
Option Explicit
Public s_CommandeNumber As String
Public shMatieres As Worksheet
Public shProduits As Worksheet
Public s_CommandeDate As String
Public shStinson As Worksheet
Sub Z_Borders()
Application.ScreenUpdating = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
End Sub
Sub Z_Trier()
Dim z As Long
Application.ScreenUpdating = False
With Sheets("Matières Premières")
    .Activate
    
    ' pourquoi effacer les colonnes pour les réinsérer un peu plus bas  !!??
    .Range("E:E,G:G,I:I,K:K,M:M,O:O,Q:Q,S:S,U:U,W:W,Y:Y,AA:AA").Delete
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=Range _
        ("d1:t1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With .Sort
        .SetRange Range("d1:t300")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With

    .Range("E:E,F:F,G:G,H:H,I:I,J:J,K:K,L:L,M:M,N:N,O:O,P:P,Q:Q,R:R,S:S,U:U,W:W,Y:Y").Insert
    .Range("E:E,G:G,I:I,K:K,M:M,O:O,Q:Q,S:S,W:W").Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
        Formula1:="=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority

    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    
    .Range("E3").Value = "Reste"
    .Range("E4").Resize(400).FormulaR1C1 = "=RC[-2]-RC[-1]"
    .Range("E4").Resize(400).NumberFormat = "General"
    
    Range("e1").Select
    
    For z = 1 To 20
        .Range("E4").Resize(400).Offset(, 2 * z).FormulaR1C1 = .Range("E4").Resize(400).FormulaR1C1
        .Range("E4").Resize(400).Offset(, 2 * z).NumberFormat = "General"
    Next
    
Range("E4").Select
    
End With


shStinson.Activate
'tri dates
Sheets("Commandes Stinson").Select
ActiveWorkbook.Worksheets("Commandes Stinson").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Commandes Stinson").Sort.SortFields.Add Key:=Range _
    ("C2:L2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("Commandes Stinson").Sort
    .SetRange Range("C1:L300")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlLeftToRight
    .SortMethod = xlPinYin
    .Apply
End With

Columns("C:V").ColumnWidth = 20
    
'cadrage
Range("C4:C138").Select
Call Z_Borders
Range("Q:Z").Select
With Selection
    Selection.Delete Shift:=xlToLeft
End With

Range("C1").Select
End Sub
Function Z_Prepare_Commande()

shStinson.Activate

' Insertion d'une colonne vide pour saisie les données commandes du formulaire.
Range("C1").EntireColumn.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

' Insertion de la date de la commande en C2, et de l'information INT en C3.
Range("C2").Value = UserForm1.TextBox41.Value
Range("C2").NumberFormat = "yyyy-mm-dd"
 Range("c3").Value = ("INT # " & UserForm1.TextBox42.Value)

With Range("c1")
    .FormulaR1C1 = "Date et quantité commandée"
    .HorizontalAlignment = xlCenter
    .WrapText = True
    .RowHeight = 68
    .Offset(3, 0).Activate
End With

' Insertion d'une colonne vide pour saisie des besoins recensés pour la commande dans la feuille Matières.
With shMatieres
    .Activate
    .Range("d:e").Insert Shift:=xlToRight   'pourquoi deux colonnes sont insérées ici ? pour plus de lisibilité ?
    .Range("D1:D2").Value = shStinson.Range("C2:C3").Value
    .Columns("D:D").EntireColumn.AutoFit
    .Range("D3").FormulaR1C1 = "Besoin"
End With

Z_Prepare_Commande = True
End Function
Sub Z_Sauvegarde_Commande()
Dim maComposante As String
Dim rgComposante As Range
Dim monProduit As String
Dim rgMatiere As Range
Dim maQuantité As Double
Dim monBesoin As Double
Dim i As Long
Dim j As Long

' Insertion des quantités des produits commandés, sachant que la liste des produits commençent en ligne 3,
For i = 1 To 20
    If UserForm1.Controls("ComboBox" & i).ListIndex <> -1 Then
        shStinson.Cells(UserForm1.Controls("ComboBox" & i).ListIndex + 3, 3).Value = UserForm1.Controls("Textbox" & i).Value
    End If
Next i

For i = 4 To shStinson.Range("A" & Rows.Count).End(xlUp).Row

    ' Lecture de la commande.
    With shStinson.Range("C" & i)
        If .Text <> "" Then
        Debug.Print shStinson.Range("C" & i).Address
            maQuantité = .Text
            monProduit = .Offset(0, -2).Text
            
            ' Recherche du produit composé dans la feuille "Produits".
            Set rgMatiere = shProduits.Rows(1).Find(what:=monProduit)
            If Not rgMatiere Is Nothing Then
                
                
                For j = 3 To shProduits.Cells(shProduits.Rows.Count, rgMatiere.Column).End(xlUp).Row
                'Do Until MaMatiere.Offset(2 + i).Text = ""
                    
                    maComposante = rgMatiere.EntireColumn.Cells(j, 1).Value
                    monBesoin = rgMatiere.EntireColumn.Cells(j, 1).Offset(, 1).Text
                    
                    ' Recherche du produit composant dans la feuille "Matières".
                    Set rgComposante = shMatieres.Columns(1).Find(what:=maComposante)
                    
                    If Not rgComposante Is Nothing Then
                        'Utilisation de l'instruction "Val" pour transformer le texte en valeur.
                        rgComposante.Offset(, 3).Value = (monBesoin * maQuantité)
                    End If
                 Next j
                 '   i = i + 1
                'Loop
            Else
                msgbox "Hoho, produit inexistant dans feuille produits" & vbCr & monProduit: Exit Sub
            End If
        End If
    End With
Next i
End Sub
Function Z_CommandeExiste()
Dim s_Formule As String
Dim s_rDates As String
Dim s_rCdes As String
Dim sep As String
sep = ","

Worksheets("Commandes Stinson").Activate
s_rDates = Range("C2").Resize(1, Cells(2, Columns.Count).End(xlToLeft).Column - 2).Address(0, 0)
s_rCdes = Range("C3").Resize(1, Cells(2, Columns.Count).End(xlToLeft).Column - 2).Address(0, 0)
s_Formule = "COUNTIFS(" & s_rDates & sep & Chr(34) & s_CommandeDate & Chr(34) & sep & s_rCdes & sep & Chr(34) & s_CommandeNumber & Chr(34) & ")"
If Evaluate(s_Formule) > 0 Then
    Z_CommandeExiste = True
End If
End Function
Function Z_CommandeBienSaisie()
Dim vResult As Boolean
Dim i As Long

'au moins un choix fait.
For i = 1 To 20
    If UserForm1.Controls("ComboBox" & i).ListIndex <> -1 Then vResult = True
Next i

'au moins une quantité saisie
For i = 1 To 20
    If UserForm1.Controls("ComboBox" & i).ListIndex <> -1 And UserForm1.Controls("Textbox" & i).Value = vbNullString Then vResult = False
    
    ' vérifier que toutes les quantités saisies soient numériques
    If UserForm1.Controls("ComboBox" & i).ListIndex <> -1 And UserForm1.Controls("Textbox" & i).Value <> vbNullString And IsNumeric(UserForm1.Controls("Textbox" & i).Value) = False Then vResult = False
Next i
Z_CommandeBienSaisie = vResult
End Function

Code à mettre dans le formulaire Userform

Dim maComposante As String
Dim rgComposante As Range
Dim monBesoin As Long
Dim t As Variant
Dim i As Byte
Dim y As Byte
Dim z As Byte

Private Sub CommandButton3_Click()
'' Construction du jeu de test
For i = 1 To 20
    Controls("ComboBox" & i).ListIndex = i
    Controls("Textbox" & i).Value = i * 10
Next i
End Sub

Private Sub UserForm_Initialize()
Set shStinson = Worksheets("Commandes Stinson")
Set shMatieres = Worksheets("Matières premières")
Set shProduits = Worksheets("Produits")

'pour plus de commodités, date pré-renseignée
TextBox41 = Format(Date, "yyyy-mm-dd")

'remplissage de chaque combobox avec la liste des articles commandables, issues de la feuille Stinson
With Sheets("Commandes Stinson")
    For i = 1 To 20
        t = .Range("a3:c" & .Cells(Rows.Count, 1).End(xlUp).Row): Controls("ComboBox" & i).List = t
    Next i
End With
TextBox41.SetFocus

End Sub
Private Sub CommandButton1_Click()

Application.EnableCancelKey = xlInterrupt
'Application.ScreenUpdating = False

If TextBox41 = "" Then
    'If MsgBox("ENTRER UNE DATE ?", vbYesNo + vbQuestion, "Avertissement : ajouter une date ?") = vbYes Then Exit Sub
    msgbox "IL FAUT ENTRER UNE DATE POUR CONTINER ?", vbExclamation, "ERREUR ... Rien ne sera ajouté"
    Exit Sub
End If

s_CommandeNumber = "INT # " & UserForm1.TextBox42.Value
s_CommandeDate = UserForm1.TextBox41.Value

If Z_CommandeExiste = True Then
    msgbox "Une entrée est déjà enregistrée pour ce couple commande/date " & s_CommandeNumber & "/ " & s_CommandeDate, vbExclamation
    Exit Sub
End If

If Z_CommandeBienSaisie = False Then
    msgbox "Vérifier que vous avez bien fait un choix et saisi toutes les quantités associées", vbExclamation
    Exit Sub
End If
'¤¤¤¤¤¤¤¤¤ Saisie des commandes Stinson ¤¤¤¤¤¤¤¤¤

' pourquoi trier maintenant ? est-ce utile quand un nouvel article est inséré ?
' je pense qu'il faudrait effectuer cela pendant l'initialisation du formulaire.
' If shStinson.Range("c4").text = "" And shStinson.Range("c4").Offset(0, -2).Text = "" Then Call Z_Trier: Call UserForm_Initialize

' puisque les données saisies et le couple commande/date contrôlée viennent d'être contrôlées,
' on peut poursuivre en préparant les deux feuilles (matières et stinson) puis en saisissant dedans.
Call Z_Prepare_Commande

Call Z_Sauvegarde_Commande

Unload Me
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub

 

[Staple1600]

Re : Userform ne se ferme pas

Bonsoir STephane

Merci pour ce travail de réécriture qui me permets d'aller me coucher alors que j'allais entamer moi aussi une partie du petit toilettage que j'avais promis à Cougar.

Merci pour lui et merci pour mes vieux os qui font pouvoir se mettre au chaud dare-dare sous la couette.

EDITION: Bonsoir kjin (voila une bonne chose de faite)

 

[kjin]

Re : Userform ne se ferme pas

Bonjour zatous,
Quand faut nettoyer faut nettoyer...!
Ca pas tout à fait pareil...je n'est pas trier les colonnes, mais bon...
En outre, je n'ai pas vu comment indiquer le n° INT...
A+
kjin

 

[Cougar]

Re : Userform ne se ferme pas

Bonjour STephane, kjin,

WOWWW que dire de plus sinon merci énormement pour votre aide. Plusieurs fonction inconnu de moi me seront utiles plus tard.

Encore une fois, mille mercis.