Erreur de compilation, boucle sans do

Le 13/11/2015 à 21:18

Bonjour,

Pour mon travail, j'utilise une macro qui attribue différentes postes. En rajoutant 2 nouveaux postes j'ai un erreur de compilation, "boucle sans do". J'ai du oublié un end if peut-être mais je ne sais pas ou. Je vous copie colle le code entier et plus bas l'erreur qui est dans la useform 5:

Sub ligne()

If MsgBox("Mise à jour des postes", vbYesNo, "Voulez-vous mettre à jour les postes ?") = vbYes Then

z = Time
Application.Calculation = xlCalculationManual

Range("A:D").Select
Selection.AutoFilter

i = 2
nb_aleatoire = Int(Rnd * 20) + 1
Range("POSTES") = ""
count_wrap = 0
nb_single = lire_cellule_nommee("nb_aleatoire_pack_single")
colonne_poste_disponible_single = Worksheet_SelectionChange(Range("single"))
nb_multi = lire_cellule_nommee("nb_aleatoire_pack_multi")
colonne_poste_disponible_multi = Worksheet_SelectionChange(Range("Multi"))
nb_multi_large = lire_cellule_nommee("nb_aleatoire_pack_multi_large")
PISL_count = lire_cellule_nommee("PISL_count")
colonne_poste_disponible_multi_large = Worksheet_SelectionChange(Range("Multi_Large"))
colonne_poste_disponible_multi_wrap = Worksheet_SelectionChange(Range("multi_wrap"))
colonne_poste_disponible_single_wrap = Worksheet_SelectionChange(Range("single_wrap"))
colonne_poste_disponible_rebin_medium = Worksheet_SelectionChange(Range("rebin_medium"))
colonne_poste_disponible_rebin_large = Worksheet_SelectionChange(Range("rebin_large"))
colonne_poste_disponible_NC = Worksheet_SelectionChange(Range("NonCon"))

PISL = Worksheet_SelectionChange(Range("PISL"))
PIMML = Worksheet_SelectionChange(Range("PIMML"))
noms = Worksheet_SelectionChange(Range("Noms"))
poste = Worksheet_SelectionChange(Range("POSTES"))
tache = Worksheet_SelectionChange(Range("Tache"))

UserForm1.Show
UserForm4.Show
UserForm5.Show
UserForm2.Show

nb_pick_L1 = Range("PiSL1")
nb_pick_L2 = Range("PiSL2")
nb_pick_L3 = Range("PiSL3")
nb_pick_L4 = Range("PiSL4")

nb_pickMM_L1 = Range("PiMM1")
nb_pickMM_L2 = Range("PiMM2")
nb_pickMM_L3 = Range("PiMM3")
nb_pickMM_L4 = Range("PiMM4")

nb_MAD4 = lire_cellule_nommee("nb_MAD4")
nb_LIL1 = lire_cellule_nommee("nb_LIL1")
nb_MXP5 = lire_cellule_nommee("nb_MXP5")
nb_LYS1 = lire_cellule_nommee("nb_LYS1")
nb_ORY1 = lire_cellule_nommee("nb_ORY1")
nb_DUS2 = lire_cellule_nommee("nb_DUS2")
nb_EUK5 = lire_cellule_nommee("nb_EUK5")

UserForm6.Show 0
UserForm6.Repaint

Application.Calculation = xlCalculationAutomatic
Do
' on descend la liste et pour chaque process on affecte au besoin une ligne ou un poste

'si c'est un packer single
If Range("B" & i) = "Pack Single" Then
nb_single = lire_cellule_nommee("nb_aleatoire_pack_single")
If nb_single = 0 Then
Range("Ligne1") = Range("single_L1")
Range("Ligne2") = Range("single_L2")
Range("Ligne3") = Range("single_L3")
Range("Ligne4") = Range("single_L4")
nb_single = lire_cellule_nommee("nb_aleatoire_pack_single")
If nb_single = 0 Then
MsgBox ("Veuillez selectionner plus de ligne en pack single")
Unload UserForm6
Exit Sub
End If
End If
Range(poste & i) = hasard(colonne_poste_disponible_single, nb_single)
If Range(poste & i) = 0 Then MsgBox ("Plus assez de poste disponible, sélectionnez d'autres lignes en Pack Single")

Range("Ligne1") = Range("single_L1")
Range("Ligne2") = Range("single_L2")
Range("Ligne3") = Range("single_L3")
Range("Ligne4") = Range("single_L4")

'on enlève les postes de la ligne du dernier packer affecté
x = Left(Right(Range(poste & i), 3), 1)
Range("Ligne" & x) = ""
End If

If Range("B" & i) = "Pack Multi Medium" Then
nb_multi = lire_cellule_nommee("nb_aleatoire_pack_multi")
If nb_multi = 0 Then
Range("MultiLigne1") = Range("Multi_L1")
Range("MultiLigne2") = Range("Multi_L2")
Range("MultiLigne3") = Range("Multi_L3")
Range("MultiLigne4") = Range("Multi_L4")
nb_multi = lire_cellule_nommee("nb_aleatoire_pack_multi")
If nb_multi = 0 Then
MsgBox ("Veuillez selectionner plus de ligne en pack multi medium")
Unload UserForm6
Exit Sub
End If
End If
Range(poste & i) = hasard(colonne_poste_disponible_multi, nb_multi)
If Range(poste & i) = 0 Then MsgBox ("Plus assez de poste disponible, sélectionnez d'autres lignes en Pack Multi")
Range("MultiLigne1") = Range("Multi_L1")
Range("MultiLigne2") = Range("Multi_L2")
Range("MultiLigne3") = Range("Multi_L3")
Range("MultiLigne4") = Range("Multi_L4")

x = Left(Right(Range(poste & i), 3), 1)
Range("MultiLigne" & x) = ""
End If

If Range("B" & i) = "Pack Multi Large" Then
nb_multi_large = lire_cellule_nommee("nb_aleatoire_pack_multi_large")
If nb_multi_large = 0 Then
MsgBox ("Veuillez selectionner plus de ligne en pack multi large")
Unload UserForm6
Exit Sub
End If
Range(poste & i) = hasard(colonne_poste_disponible_multi_large, nb_multi_large)
If Range(poste & i) = 0 Then MsgBox ("Plus assez de poste disponible, sélectionnez d'autres lignes en Pack Multi Large")
End If

If Range("B" & i) = "Pack Non Con" Then
nb_NC = lire_cellule_nommee("nb_aleatoire_pack_NC")
If nb_NC = 0 Then
MsgBox ("Veuillez selectionner plus de ligne en pack Non Con")
Unload UserForm6
Exit Sub
End If
Range(poste & i) = hasard(colonne_poste_disponible_NC, nb_NC)
If Range(poste & i) = 0 Then MsgBox ("Plus assez de poste disponible, sélectionnez d'autres lignes en Pack NonCon")
End If

If Range("B" & i) = "Rebin" Then
nb_rebin_medium = lire_cellule_nommee("nb_aleatoire_rebin_medium")
nb_rebin_large = lire_cellule_nommee("nb_aleatoire_rebin_large")
If nb_rebin_medium = 0 And nb_rebin_large = 0 Then
MsgBox ("il n'y a pas assez de rebinners affectés! Revoyez les besoins et ajustez ou ajuster la QTY")
Exit Sub
End If

If nb_rebin_large >= nb_rebin_medium Then
Range(poste & i) = hasard(colonne_poste_disponible_rebin_large, nb_rebin_large)
Else
Range(poste & i) = hasard(colonne_poste_disponible_rebin_medium, nb_rebin_medium)
End If
End If

If Range("B" & i) = "Wrap" Then
nb_wrap1 = lire_cellule_nommee("nb_aleatoire_multi_wrap")
nb_wrap2 = lire_cellule_nommee("nb_aleatoire_single_wrap")
If nb_wrap1 = 0 And nb_wrap2 = 0 Then
MsgBox ("Veuillez selectionner plus de ligne en pack wrap")
Unload UserForm6
Exit Sub
End If

If count_wrap = 0 Then
colonne_poste_disponible = colonne_poste_disponible_single_wrap
nb_wrap = nb_wrap2
count_wrap = 1
Else
colonne_poste_disponible = colonne_poste_disponible_multi_wrap
nb_wrap = nb_wrap1
count_wrap = 0
End If

Range(poste & i) = hasard(colonne_poste_disponible, nb_wrap)
If Range(poste & i) = 0 Then
MsgBox ("Plus assez de poste disponible, sélectionnez d'autres lignes en Pack Multi Large")
Unload UserForm6
End If
End If

If Range(tache & i) = "Pick Single" Then
    If nb_pick_L1 > 0 Then
    Range(poste & i) = "Ligne 1"
    nb_pick_L1 = nb_pick_L1 - 1
    Else
        If nb_pick_L2 > 0 Then
        Range(poste & i) = "Ligne 2"
        nb_pick_L2 = nb_pick_L2 - 1
        Else
            If nb_pick_L3 > 0 Then
            Range(poste & i) = "Ligne 3"
            nb_pick_L3 = nb_pick_L3 - 1
            Else
                If nb_pick_L4 > 0 Then
                Range(poste & i) = "Ligne 4"
                nb_pick_L4 = nb_pick_L4 - 1
                End If
            End If
        End If
    End If
End If

If Range(tache & i) = "Pick MultiM" Then
    If nb_pickMM_L1 > 0 Then
    Range(poste & i) = "Ligne 1"
    nb_pickMM_L1 = nb_pickMM_L1 - 1
    Else
        If nb_pickMM_L2 > 0 Then
        Range(poste & i) = "Ligne 2"
        nb_pickMM_L2 = nb_pickMM_L2 - 1
        Else
            If nb_pickMM_L3 > 0 Then
            Range(poste & i) = "Ligne 3"
            nb_pickMM_L3 = nb_pickMM_L3 - 1
            Else
                If nb_pickMM_L4 > 0 Then
                Range(poste & i) = "Ligne 4"
                nb_pickMM_L4 = nb_pickMM_L4 - 1
                End If
            End If
        End If
    End If
End If

If Range(tache & i) = "Pick Tranship" Then

If nb_MAD4 > 0 Then
nb_MAD4 = nb_MAD4 - 1
Range(poste & i) = "Transhipment MAD4"
Else
If nb_LIL1 > 0 Then
nb_LIL1 = nb_LIL1 - 1
Range(poste & i) = "Transhipment LIL1"
Else
If nb_MXP5 > 0 Then
nb_MXP5 = nb_MXP5 - 1
Range(poste & i) = "Transhipment MXP5"
Else
If nb_LYS1 > 0 Then
nb_LYS1 = nb_LYS1 - 1
Range(poste & i) = "Transhipment LYS1"
Else
If nb_ORY1 > 0 Then
nb_ORY1 = nb_ORY1 - 1
Range(poste & i) = "Transhipment ORY1"
Else
If nb_DUS2 > 0 Then
nb_DUS2 = nb_DUS2 - 1
Range(poste & i) = "Transhipment DUS2"
Else
If nb_EUK5 > 0 Then
nb_EUK5 = nb_EUK5 - 1
Range(poste & i) = "Transhipment EUK5"
Else
MsgBox ("Veuillez vérifier le nombre de pickers Tranship." & _
"Incompatibilité entre le nombre de pickers affectés avec le nombre de picker par process")
End If
End If
End If
End If
End If
End If
End If

i = i + 1
Loop Until Range(noms & i) = ""

End If

Range("A:D").Select
Selection.AutoFilter

Unload UserForm6
y = Time

MsgBox (z & " " & y)
End Sub

L'erreur, a priori est là:

If Range(tache & i) = "Pick Tranship" Then

If nb_MAD4 > 0 Then
nb_MAD4 = nb_MAD4 - 1
Range(poste & i) = "Transhipment MAD4"
Else
If nb_LIL1 > 0 Then
nb_LIL1 = nb_LIL1 - 1
Range(poste & i) = "Transhipment LIL1"
Else
If nb_MXP5 > 0 Then
nb_MXP5 = nb_MXP5 - 1
Range(poste & i) = "Transhipment MXP5"
Else
If nb_LYS1 > 0 Then
nb_LYS1 = nb_LYS1 - 1
Range(poste & i) = "Transhipment LYS1"
Else
If nb_ORY1 > 0 Then
nb_ORY1 = nb_ORY1 - 1
Range(poste & i) = "Transhipment ORY1"
Else
If nb_DUS2 > 0 Then
nb_DUS2 = nb_DUS2 - 1
Range(poste & i) = "Transhipment DUS2"
Else
If nb_EUK5 > 0 Then
nb_EUK5 = nb_EUK5 - 1
Range(poste & i) = "Transhipment EUK5"
Else
MsgBox ("Veuillez vérifier le nombre de pickers Tranship." & _
"Incompatibilité entre le nombre de pickers affectés avec le nombre de picker par process")
End If
End If
End If
End If
End If
End If
End If

i = i + 1
Loop Until Range(noms & i) = ""

End If

Range("A:D").Select
Selection.AutoFilter

Unload UserForm6
y = Time

MsgBox (z & " " & y)
End Sub

Loop Until Range(noms & i) = ""

Merci d'avance

Le 13/11/2015 à 21:28

Bonsoir,

Possible d'avoir un fichier ?

Merci !

Bouben

Le 13/11/2015 à 21:49

C'est une usine à gaz ce fichier, il est trop gros pour être envoyé sur le forum (2.72 Mo), même en essayant de le compresser. Je ne vois pas comment te l'envoyer

Le 13/11/2015 à 22:20

Bonsoir

Il te manque un End If

      If Range(tache & i) = "Pick Tranship" Then

        If nb_MAD4 > 0 Then
          nb_MAD4 = nb_MAD4 - 1
          Range(poste & i) = "Transhipment MAD4"
        Else
          If nb_LIL1 > 0 Then
            nb_LIL1 = nb_LIL1 - 1
            Range(poste & i) = "Transhipment LIL1"
          Else
            If nb_MXP5 > 0 Then
              nb_MXP5 = nb_MXP5 - 1
              Range(poste & i) = "Transhipment MXP5"
            Else
              If nb_LYS1 > 0 Then
                nb_LYS1 = nb_LYS1 - 1
                Range(poste & i) = "Transhipment LYS1"
              Else
                If nb_ORY1 > 0 Then
                  nb_ORY1 = nb_ORY1 - 1
                  Range(poste & i) = "Transhipment ORY1"
                Else
                  If nb_DUS2 > 0 Then
                    nb_DUS2 = nb_DUS2 - 1
                    Range(poste & i) = "Transhipment DUS2"
                  Else
                    If nb_EUK5 > 0 Then
                      nb_EUK5 = nb_EUK5 - 1
                      Range(poste & i) = "Transhipment EUK5"
                    Else
                      MsgBox ("Veuillez vérifier le nombre de pickers Tranship." & _
                              "Incompatibilité entre le nombre de pickers affectés avec le nombre de picker par process")
                    End If
                  End If
                End If
              End If
            End If
          End If
        End If
      End If
      i = i + 1
    Loop Until Range(noms & i) = ""

  End If

  Range("A:D").Select
  Selection.AutoFilter

  Unload UserForm6
  y = Time

  MsgBox (Z & " " & y)
End Sub

Mais je trouve étrange cette façon de coder

colonne_poste_disponible_single = Worksheet_SelectionChange(Range("single"))

Worksheet_SelectionChange n'est pas une fonction ou alors tu as détourné cette procédure

Je serais curieux (juste pour ma formation) de voir ton fichier

Passe par cjoint http://cjoint.com/index.php

Le 14/11/2015 à 08:30

J'ai ajouté le end if mais sa veut pas lire la useform 5, je t'envoie le fichier pour voir si tu arrives

Merci d'avance

Le 14/11/2015 à 13:14

Bonjour

Je pense avoir trouvé le problème de l'erreur de compilation

As tu un message d'erreur ?

Ensuite pour la conception du programme je ne sais pas si je vais trouver

Tu as pensé ton programme d'une certaine manière (que je ne connais pas) et pas sur que je retrouve ta logique

Je veux bien regarder mais sans conviction

Avec le mot de passe cela serait mieux

A la vue de ton code que tu as posté, il passe par le Userform1, Userform4, Userform5 et Userform2

Si tu dis qu'il ne passe pas par l'Userform5 c'est (je pense) dans la condition d'ouverture de l'Userform5 qu'il faut chercher

Le 14/11/2015 à 13:27

Le mdp est en commentaire, une fois le lien ouvert

Le message d'erreur est :

Erreur d'execution 1004

La methode 'range' de l'objet'_Global' a echoué

Le 14/11/2015 à 13:56

Bonjour

La prochaine fois indique les actions à faire pour arriver au problème (on gagnera du temps)

Sinon cela se passe dans la procédure Userform_Initialize de l'userform5

TextBox8.Value = Range("nb_EK5").Value

nb_EK5 est inconnu, je n'ai trouvé que nb_EUK5

Le 14/11/2015 à 13:57

Bonjour,

Pour voir plus facilement clair dans ton code, tu peux installer

qui indente le code VBA

d'autre part, tu peux compiler le projet via le menu ad hoc.

Le 14/11/2015 à 14:22

SA MARCHE!!!!

Tout cela car j'ai oublié un U, je ferais plus attention aux prochains changements. Je vous mettrais toutes les étapes de mon changement la prochaine fois

En tout cas merci, j'apprends vraiment beaucoup grâce a ce site et le forum

Je vais installer Indenter VBA pour faciliter la lecture du code.

Merci Banzai64 et Patrick1957

Rechercher des sujets similaires à "erreur compilation boucle"