Procédure qui redémarre automatiquement

Le 06/06/2019 à 09:14

Bonjour le forum,

Aujourd'hui rien de bien compliquer pour les plus forts d'entre vous

J'ai une userforme ou je rentre des données, lorsque l'opérateur oublie ou zap une texte box ou combo box

Je lui fait apparaître un message lui disant --> renseigner la valeur ....

Seulement une fois que tout les msgbox ce sont affiché,

comme le code ne li pas ces valeur, il m’affiche une erreur d’exécution ce qui est tout a fait légitime.

J'aimerais, si quelqu'un connait l'astuce, au lieux de faire planter la procédure j'aimerais qu'il la redémarre en boucle jusqu’à ce que le formulaire sois complet, tout en affichant les msgbox associé au saisie manquante

Je vous ai joint un morceau de fichier pour que vous puissiez y voir plus claire.

Merci de prendre le temps pour résoudre mon problème

9projet-vba-soudure-prof-copie.xlsm (57.69 Ko)

Le 06/06/2019 à 10:23

Bonjour,

En préambule, j'ai apporté quelques modifications à ton code :

Modification de l'indentation pour faciliter la lecture du code
Suppression de nombreux espaces et mise en bout de ligne de certains commentaires pour condenser le code
Ajout d'une structure "With Sheets("Truc")...End With" pour éviter l'activation inutile d'une feuille
Suppression des Offset, intégrés directement dans l'index colonne des "Cells(Ligne, Colonne)", pour simplifier le code

Concernant ton problème :

Ajout d'une variable booléenne ("Complet") qui prend la valeur "FAUX" dès qu'un élément est manquant
Ajout d'une instructions pour quitter la procédure si Complet est FAUX

Le code :

Private Sub Btnajout_Click()

'***************************
'Définition des variable
'***************************
Dim resProfondeur As Double, resSection As Double, resSection1 As Double, resSection2, resFinal As Double, resLong As Double
Dim resVolume As Double, resPoids As Double, resTemps As Double, resPasse As Double, resNbPasse As Double
Dim resTempsSoudure As Double, resPrixFlux As Double, resConsoFlux As Double, resCoutMetal As Double, resCoutFlux As Double
Dim resTotal As Double, Complet As Boolean

'**********************
'afficher un message
'**********************
Complet = True
If lblAffaire.Value = "" Then
    MsgBox "Renseigner un numéro d'affaire"
    Complet = False
End If

If lblDiametre.Value = "" Or lblLongueur.Value = "" Then
    MsgBox "Renseigner un diamètre ou une longueur"
    Complet = False
Else
    MsgBox "Longueur de soudure enregistré !"
End If

If lblEp.Value = "" Then
    MsgBox "Renseigner une epaisseur"
    Complet = False
End If

If lblNombre.Value = "" Then
    MsgBox "Renseigner un nombre de soudure"
    Complet = False
End If

If cboAngle.Value = "" Then
    MsgBox "Renseigner un angle de chanfrein"
    Complet = False
End If

If lbljeudesoudage.Value = "" Then
    MsgBox "Renseigner un jeu de soudage"
    Complet = False
Else
    MsgBox "Section de soudure calculée !"
End If

If cbopoids.Value = "" Then
    MsgBox "Renseigner la densité du métal d'apport"
    Complet = False
End If

If lblMetal.Value = "" Then
    MsgBox "Renseigner le prix au kg du métal d'apport"
    Complet = False
End If

If Not Complet Then Exit Sub 'Sortir de la procédure ici si info manquante
varderligne = Sheets("Source SAW").Range("A65000").End(xlUp).Row

'************************
'Procédure permetant de determiner la profondeur du cordon
'******************************

If lblEp.Value <= 18 Then
    resProfondeur = lblEp.Value * 1.25
Else
    If lblEp.Value <= 28 Then resProfondeur = lblEp.Value * 1.2 Else resProfondeur = lblEp.Value * 1.15
End If

'***********************
'Calcul de la section
'***********************

If cboType.Value = "V égale" Then
    resoppose = (Math.Tan((cboAngle.Value / 2) * (3.14159 / 180)) * resProfondeur) * resProfondeur
    resSection = (resoppose + (lbljeudesoudage.Value * resProfondeur)) / 100
    resFinal = resSection
Else
    If cboType.Value = "X égale" Then
        resoppose = (Math.Tan((cboAngle.Value / 2) * (3.14159 / 180)) * (resProfondeur / 2)) * (resProfondeur / 2)
        resSection1 = ((resoppose + lbljeudesoudage.Value * (resProfondeur / 2)) * 2) / 100
        resFinal = resSection1
    Else
        resOppose1 = (Math.Tan((cboAngle.Value / 2) * (3.14159 / 180)) * lblGrande) * lblGrande
        resOppose2 = (Math.Tan((cboAngle.Value / 2) * (3.14159 / 180)) * lblPetite) * lblPetite
        resSection2 = ((resOppose1 + resOppose2) + (lbljeudesoudage.Value * resProfondeur)) / 100
        resFinal = resSection2
    End If
End If

'******************************
'Calcul de la longeur à souder
'*******************************

If lblDiametre = "" Then resLong = lblLongueur Else resLong = ((lblDiametre.Value - lblEp.Value) * 3.14159)
resVolume = (resFinal * (resLong / 10)) / 1000 'volume d'un cordons
resPoids = ((resVolume * lblNombre) * cbopoids) * 1.1 'Calcul poids metal a deposer
resTemps = (0.17 * resLong) / 1000 'Calcul de temps par passe de soudure
resPasse = resFinal * 4 'Calcul nombre de passe/Soudure
resNbPasse = resPasse * lblNombre ' Calcule nombre de passe TOTAL
resTempsSoudure = resTemps * resNbPasse 'Calcul temps de soudure
resPrixFlux = 2.49 'Prix du flux
resConsoFlux = resPoids * 3 'Consommation du flux
resCoutMetal = resPoids * lblMetal 'Cout métal d'apport a deposer
resCoutFlux = resPrixFlux * resConsoFlux 'Cout du flux
resTotal = resCoutMetal + resCoutFlux 'Cout Total

With Sheets("Source SAW")
    .Cells(varderligne + 1, 1).Value = CStr(lblAffaire.Value)
    If lblDiametre = "" Then .Cells(varderligne + 1, 2) = "" Else .Cells(varderligne + 1, 2) = CDbl(lblDiametre.Value)
    If lblLongueur = "" Then .Cells(varderligne + 1, 3) = "" Else .Cells(varderligne + 1, 3) = CDbl(lblLongueur.Value)
    .Cells(varderligne + 1, 4) = CDbl(lblEp.Value)
    .Cells(varderligne + 1, 5) = CDbl(lblNombre.Value)
    .Cells(varderligne + 1, 6) = CDbl(resProfondeur)
    .Cells(varderligne + 1, 7) = CDbl(cboAngle.Value)
    .Cells(varderligne + 1, 8) = (cboType.Value)
    .Cells(varderligne + 1, 9) = CDbl(lblTalon.Value)
    .Cells(varderligne + 1, 10) = CDbl(lbljeudesoudage.Value)
    .Cells(varderligne + 1, 11) = CDbl(cbopoids.Value)
    .Cells(varderligne + 1, 12) = CDbl(lblMetal.Value)
    If lblPetite = "" Or lblGrande = "" Then
        .Cells(varderligne + 1, 15) = ""
        .Cells(varderligne + 1, 16) = ""
    Else
        .Cells(varderligne + 1, 15) = CDbl(lblPetite.Value)
        .Cells(varderligne + 1, 16) = CDbl(lblGrande.Value)
    End If
   .Cells(varderligne + 1, 19) = resFinal
   .Cells(varderligne + 1, 20) = resLong
   .Cells(varderligne + 1, 21) = resVolume
   .Cells(varderligne + 1, 22) = resPoids
   .Cells(varderligne + 1, 26) = resTemps
   .Cells(varderligne + 1, 27) = resPasse
   .Cells(varderligne + 1, 28) = resNbPasse
   .Cells(varderligne + 1, 29) = resTempsSoudure
   .Cells(varderligne + 1, 30) = resPrixFlux
   .Cells(varderligne + 1, 31) = resConsoFlux
   .Cells(varderligne + 1, 35) = resCoutMetal
   .Cells(varderligne + 1, 36) = resCoutFlux
   .Cells(varderligne + 1, 37) = resTotal
End With

End Sub

Le 06/06/2019 à 11:14

Bonjour,

personnellement je ferai des "exit sub" à chaque fois qu'il manque une info.

Le seul intérêt de continuer la procédure ce serait de remplacer les "msgbox" par des "InputBox" afin

d'avoir l'info manquante et continuer la procédure.

Le 06/06/2019 à 11:17

Bonjour,

Ci-joint une solution...

6projet-vba-soudure-prof.xlsm (64.68 Ko)

Le 06/06/2019 à 19:06

Merci à tous pour vos réponses, je suis vraiment reconnaissant envers vous merci de chercher le bon code le plus simple

j’essaie ça demain et vous retient au courant

Bonne soirée

Le 07/06/2019 à 11:38

Pedro22 et oxydum pour vos propositon seulement avec ton codes les données saisie ne son plus ajouté dans la feuille excel

Ce qui est asser emmerdant car du coup il on ne sais pas ou arrive les donnés

Est ce que quelqu’un aurait la solution ?

Le 07/06/2019 à 11:45

Xmenpl a écrit :
Bonjour,
personnellement je ferai des "exit sub" à chaque fois qu'il manque une info.
Le seul intérêt de continuer la procédure ce serait de remplacer les "msgbox" par des "InputBox" afin
d'avoir l'info manquante et continuer la procédure.

Bonjour

Comment fait n pour appliquer cette procédure ??

Le 07/06/2019 à 11:52

marius98 a écrit :
Pedro22 et oxydum pour vos propositon seulement avec ton codes les données saisie ne son plus ajouté dans la feuille excel
Ce qui est asser emmerdant car du coup il on ne sais pas ou arrive les donnés
Est ce que quelqu’un aurait la solution ?

Comme dis plus haut il n'y a pas d'intérêt à vouloir poursuivre le code si la cellule n'est pas renseignée.

Comme tu utilises des messages box l'utilisateur ne peux pas donner l'information avant la fin de la procédure.

Donc aucun intérêt.

Autant faire des "Exit sub" après chaque test si la cellule est vide. et demander à l'utilisateur de "revalider après modification du champ manquant".

8projet-vba-soudure-prof-copie-2.xlsm (52.46 Ko)

Principe : condition 1 alors : message plus arrêt du code ….. sinon .... code continue

If textbox1=""then

'ton message box et on sort du code avec

Exit sub

sinon : le code continue.

j'ai laissé les messages concernant le moment ou le calcul et fait mais bof vois pas trop l'utilité non plus.

si il oublie trois infos il aura droit à trois fois le message sur le calcul aggaçant à la longue

Rechercher des sujets similaires à "procedure qui redemarre automatiquement"