Plusieurs UserForm, bug des listes déroulantes

Le 11/12/2013 à 11:38

Bonjour la foule,

Une année se passe sans embrouille grâce à vos conseils avisés, merci encore pour votre aide.

Cependant, arrive la nouvelle année, qui implique un réorganisation de nos dossiers telle que :

Je travail sur Excell 2010 (si cela à une importance?).

J'ai mis au point un fichier d'archivage qui utilise un UserForm pour l'année 2013

Ma liste ayant évolué je dois crée la nouvelle année 2014 impliquant de nouveaux onglets et ajout d'un nouvel UserForm.

Avant ça marchait de cette manière, l'UserForm se faisant appeler de cette manière à la Ligne 41 :

Sub new_ligne()
'
' new_ligne Macro
    ActiveCell.Offset(1, 0).Select
    Dim lg As Integer
    lg = ActiveCell.Row
    Range("A" & lg).EntireRow.Insert
    Range("A" & lg - 1 & ":AI" & lg - 1).Copy
    Range("A" & lg).PasteSpecial Paste:=xlPasteAll
    Application.CutCopyMode = False
    ActiveCell.Offset(0, 1).Select
    Selection.ClearContents
    ActiveCell.Offset(0, 1).Select
    Selection.ClearContents
    ActiveCell.Offset(0, 1).Select
    Selection.ClearContents
    ActiveCell.Offset(0, 4).Select
    Selection.ClearContents
    ActiveCell.Offset(0, 1).Select
    Selection.ClearContents
    ActiveCell.Offset(0, 17).Select
    Selection.ClearContents
    ActiveCell.Offset(0, 1).Select
    Selection.ClearContents
    ActiveCell.Offset(0, 1).Select
    Selection.ClearContents
    ActiveCell.Offset(0, 1).Select
    Selection.ClearContents
    ActiveCell.Offset(0, 1).Select
    Selection.ClearContents
    ActiveCell.Offset(0, 1).Select
    Selection.ClearContents
    ActiveCell.Offset(0, 1).Select
    Selection.ClearContents
    ActiveCell.FormulaR1C1 = "=R[-1]C+0.1"
    ActiveCell.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(0, -30).Select
    UserForm1.Show
    ActiveWorkbook.Save
    ActiveCell.Offset(0, -1).Select
    Selection.Copy
        nomfichier2 = Range("AE" & lg - 1)
        Workbooks.Open Filename:=nomfichier2
        Sheets("Donnée").Select
            Range("B2").Select 'Copie/Colle no offre, répertoire et sauvegarde
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("R20:R22").Select
    Selection.Copy
    Range("B20").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Dim chemin As String, rep As String, srep As String, ssrep1 As String, ssrep2 As String, ssrep3 As String, nomfichier As String 'Partie sauvegarde
        rep = "T:\2013 Offres\" & Range("B20")
        If Dir(rep, vbDirectory) = "" Then VBA.MkDir rep
        srep = "T:\2013 Offres\" & Range("B20") & Range("B21")
        If Dir(srep, vbDirectory) = "" Then VBA.MkDir srep
        ssrep1 = "T:\2013 Offres\" & Range("B20") & Range("B21") & "Photos\"
        If Dir(ssrep1, vbDirectory) = "" Then VBA.MkDir ssrep1
        ssrep2 = "T:\2013 Offres\" & Range("B20") & Range("B21") & "Correspondances\"
        If Dir(ssrep2, vbDirectory) = "" Then VBA.MkDir ssrep2
        ssrep3 = "T:\2013 Offres\" & Range("B20") & Range("B21") & "Dessins\"
        If Dir(ssrep3, vbDirectory) = "" Then VBA.MkDir ssrep3
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    nomfichier = Range("B22") & ".xlsx"
    MsgBox "Sauvegardé en tant que : <" & nomfichier & ">"
    With ActiveWorkbook
        chemin = "T:\2013 Offres\" & Range("B20") & Range("B21")
        .SaveAs Filename:=chemin & nomfichier
    End With
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With 'Fin Partie sauvegarde

    Range("B1").Select 'Sélectionn Archivage.xlsm pour sauvegarder et fermer
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    ActiveWorkbook.Close
End Sub

Et mon UserForm1 est codé de cette manière (et cela fonctionne) :

Private Sub UserForm_Initialize()
'Macro dan 16/05/12
Dim auteur
Dim client
Dim sousrep
Dim base
With Sheets("Auteur")
auteur = .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
End With
With Sheets("Liste d'Adresse")
client = .Range("B4:B" & .Range("B" & Rows.Count).End(xlUp).Row)
End With
With Sheets("2013")
sousrep = .Range("D4:D" & .Range("D" & Rows.Count).End(xlUp).Row)
End With
With Sheets("base")
base = .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
End With
ComboBox1.List() = auteur
ComboBox2.List() = client
ComboBox3.List() = sousrep
ComboBox4.List() = base
End Sub

Private Sub CommandButton1_Click()
'Macro dan 16/05/12
Dim lg As Integer
    lg = ActiveCell.Row
With Sheets("2013")
    .Range("B" & lg) = Me.ComboBox1.Value
    .Range("C" & lg) = Me.ComboBox2.Value
    .Range("D" & lg) = Me.ComboBox3.Value
    .Range("H" & lg) = Me.ComboBox4.Value
End With
Unload UserForm1
End Sub

Je crée mon onglet 2014 et modifie mes codes de cette manière.

D'abord pour le code "appelant" le nouvel UserForm de cette manière :

Sub new_ligne_14()
'
' new_ligne Macro
    ActiveCell.Offset(1, 0).Select
    Dim lg As Integer
    lg = ActiveCell.Row
    Range("A" & lg).EntireRow.Insert
    Range("A" & lg - 1 & ":AI" & lg - 1).Copy
    Range("A" & lg).PasteSpecial Paste:=xlPasteAll
    Application.CutCopyMode = False
    ActiveCell.Offset(0, 1).Select
    Selection.ClearContents
    ActiveCell.Offset(0, 1).Select
    Selection.ClearContents
    ActiveCell.Offset(0, 1).Select
    Selection.ClearContents
    ActiveCell.Offset(0, 4).Select
    Selection.ClearContents
    ActiveCell.Offset(0, 1).Select
    Selection.ClearContents
    ActiveCell.Offset(0, 17).Select
    Selection.ClearContents
    ActiveCell.Offset(0, 1).Select
    Selection.ClearContents
    ActiveCell.Offset(0, 1).Select
    Selection.ClearContents
    ActiveCell.Offset(0, 1).Select
    Selection.ClearContents
    ActiveCell.Offset(0, 1).Select
    Selection.ClearContents
    ActiveCell.Offset(0, 1).Select
    Selection.ClearContents
    ActiveCell.Offset(0, 1).Select
    Selection.ClearContents
    ActiveCell.FormulaR1C1 = "=R[-1]C+0.1"
    ActiveCell.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(0, -30).Select
    UserForm2.Show
    ActiveWorkbook.Save
    ActiveCell.Offset(0, -1).Select
    Selection.Copy
        nomfichier2 = Range("AE" & lg - 1)
        Workbooks.Open Filename:=nomfichier2
        Sheets("Donnée").Select
            Range("B2").Select 'Copie/Colle no offre, répertoire et sauvegarde
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("R20:R22").Select
    Selection.Copy
    Range("B20").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Dim chemin As String, rep As String, srep As String, ssrep1 As String, ssrep2 As String, ssrep3 As String, nomfichier As String 'Partie sauvegarde
        rep = "T:\2014 Offres\" & Range("B20")
        If Dir(rep, vbDirectory) = "" Then VBA.MkDir rep
        srep = "T:\2014 Offres\" & Range("B20") & Range("B21")
        If Dir(srep, vbDirectory) = "" Then VBA.MkDir srep
        ssrep1 = "T:\2014 Offres\" & Range("B20") & Range("B21") & "Photos\"
        If Dir(ssrep1, vbDirectory) = "" Then VBA.MkDir ssrep1
        ssrep2 = "T:\2014 Offres\" & Range("B20") & Range("B21") & "Correspondances\"
        If Dir(ssrep2, vbDirectory) = "" Then VBA.MkDir ssrep2
        ssrep3 = "T:\2014 Offres\" & Range("B20") & Range("B21") & "Dessins\"
        If Dir(ssrep3, vbDirectory) = "" Then VBA.MkDir ssrep3
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    nomfichier = Range("B22") & ".xlsx"
    MsgBox "Sauvegardé en tant que : <" & nomfichier & ">"
    With ActiveWorkbook
        chemin = "T:\2014 Offres\" & Range("B20") & Range("B21")
        .SaveAs Filename:=chemin & nomfichier
    End With
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With 'Fin Partie sauvegarde

    Range("B1").Select 'Sélectionn Archivage.xlsm pour sauvegarder et fermer
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    ActiveWorkbook.Close
End Sub

Puis je crée mon UserForm2 de cette façon :

Private Sub UserForm_Initialize()
'Macro dan 16/05/12
Dim auteur
Dim client
Dim sousrep
Dim base
With Sheets("Auteur")
auteur = .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
End With
With Sheets("Liste d'Adresse")
client = .Range("B4:B" & .Range("B" & Rows.Count).End(xlUp).Row)
End With
With Sheets("2014")
sousrep = .Range("D4:D" & .Range("D" & Rows.Count).End(xlUp).Row)
End With
With Sheets("base")
base = .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
End With
ComboBox1.List() = auteur
ComboBox2.List() = client
ComboBox3.List() = sousrep
ComboBox4.List() = base
End Sub

Private Sub CommandButton1_Click()
'Macro dan 16/05/12
Dim lg As Integer
    lg = ActiveCell.Row
With Sheets("2014")
    .Range("B" & lg) = Me.ComboBox1.Value
    .Range("C" & lg) = Me.ComboBox2.Value
    .Range("D" & lg) = Me.ComboBox3.Value
    .Range("H" & lg) = Me.ComboBox4.Value
End With
Unload UserForm2
End Sub

Et paf ! Elène s'égara... Message d'erreur d'exécution '381' :

Impossible de définir la propriété List. Index de table de propriétés non valide.

Débogage =

UserForm2.Show

ne marche pas.

Ce qui est drôle, c'est que mon UserForm1 fonctionne toujours, mais pas l'UserForm2.

J'ai pas mal bidouillé, j'ai fouillé dans le forum, tout vraiment...

Et à un moment j'ai tenté de renommer les

Private Sub UserForm_Initialize()

Private Sub UserForm2_Initialize()

. Résultat meilleur mais les listes déroulantes, eux, ne fonctionnent plus. Rhâaa.

Mon fichier excel étant trop volumineux pour être téléchargé ici (~18Mo), je puis le fournir par mail ou autre.

J'ai besoin de votre science siouplait.

Le 11/12/2013 à 13:00

Bonjour,

Je vois que c'est moi qui t'ai fait les codes. Peut-être que tu peux me donner le lien sur le forum ?

Vérifie le nom

de ton USERFORM quand tu parles --> UserForm2.Show
le nom de tes feuilles "Auteur, liste d'adresse, base....

Tu dois toujours laisser Private Sub UserForm_Initialize() et pas Private Sub UserForm2_Initialize()

Le code doit être placé dans l'userform concernée (donc l'userform2 si je comprends ce que tu fais.

A te relire

Le 11/12/2013 à 14:00

Yep, le nom UserForm y correspond, cependant, il se peut que je ne regarde pas au bon endroit.

Voici un lien pour le fichier :

- Archive.xlsm (18.96Mb)

Lien permettant d'accéder aux fichiers: edit Dan Supprimé lien car Fichier avec données confidentielles

Le 11/12/2013 à 16:57

Normal tu n'as aucune données en colonne D de la feuille 2014.

Pour éviter cela mets quelques données ou dans la Private sub userform2 initialiaze, ajoute l'instruction On error resume next juste après le END WITH

A te relire

Le 12/12/2013 à 06:56

Merci ! merci ...

C'est marrant, le mélange de soulagement et de frustration que j'ai à chaque fois que j'ai une solution.

Merci DAN pour ta réponse, et encore bravo pour ce site juste formidable.

Au plaisir de vous relire.

Le 17/12/2013 à 08:23

Re-bonjour tout le monde,

Je reviens vers vous pour vous exposer un nouveau problème dans ce même fichier.

du jour au lendemain, j'ai eu ce message d'erreur :

Cela concerne les macros :

Il faut savoir que tout fonctionnait à merveille pendant au moins 2 jours.

J'ai contrôlé le chemin et le nom de fichier, tout correspond.

Je force la macro (F5) elle reprend son cours et se termine correctement !?

Est-ce qu'il doit faire une mini pause entre la sauvegarde et l'ouverture ?

Est-ce du à un fichier trop volumineux ?

Est-ce du à la longueur du chemin et du texte ? (qui n'était pas un problème avant...)

Peut-on obtenir une ouverture de fichier avec un autre code ?

Voilà, voilà voilà... Au secours donc.

Le 17/12/2013 à 13:16

la variable "lg" vaut quoi à ce moment là ??

Attention que tu utilises la cellule active pour récupérer la valeur de la ligne et ce, depuis ton userform2.

Si tu cliques sur le bouton OK dans l'userform2, vérifie que c'est la bonne feuille car j'avais uniquement considéré la feuille 2014.

Le souci vient peut être de là

A te relire

Le 17/12/2013 à 15:40

La variable lg est correcte, elle représente le chemin et le nom de fichier que je veux atteindre autant sur 2013 que 2014.

L'erreur se produit sur la feuille 2013 que 2014.

Le plus bizarre, c'est que quand je lui demande (au débogage) de continuer (F5), toutes les manipulations se font correctement.

Mon but est atteint comme avant, sauf que maintenant j'ai ce message d'erreur en plus.

Je constate donc que ce message d'erreur ne sert à rien, existe-il un code qui permet de l’abolir ?

Crois-tu qu'il y a quelque chose à faire dans ce code de mon UserForm(2) pour éviter le message d'erreur ?

Private Sub CommandButton1_Click()
'Macro dan 16/05/12
Dim lg As Integer
    lg = ActiveCell.Row
With Sheets("2013")
    .Range("B" & lg) = Me.ComboBox1.Value
    .Range("C" & lg) = Me.ComboBox2.Value
    .Range("D" & lg) = Me.ComboBox3.Value
    .Range("H" & lg) = Me.ComboBox4.Value
End With
On Error Resume Next
Unload UserForm1
End Sub

ou ici ?

    Selection.Copy
        nomfichier2 = Range("AE" & lg - 1)
        Workbooks.Open Filename:=nomfichier2
        Sheets("Donnée").Select

Le 17/12/2013 à 16:48

re,

La variable lg est correcte, elle représente le chemin et le nom de fichier que je veux atteindre autant sur 2013 que 2014.

Lg représente la ligne concernée pour ta recherche en AE

Est-ce que tu peux me dire sur quelle ligne tu te trouves lorsque tu as ce bug afin que je reproduise le souci.

Le 18/12/2013 à 07:19

Si je suis sur la ligne 1311 pour l'exécution, la lg correspond à 1312

Et la valeur nomfichier2 correspond à

Ce qui est juste...

Le bug "message" apparaît sur toutes les lignes.

Genre si je suis sur la ligne 24, la lg=25, bug.

Le 19/12/2013 à 08:04

Pourrais-tu sur base du fichier que tu as placé sur le forum, me donner le déroulé des opérations que tu fais avant de exécuter le code et une fois fait, quelle est la macro que tu exécutes. C'est la New ligne je suppose ?

cela va me permettre de comprendre comment tu fonctionnes et surtout de reproduire l'erreur pour t'aider

A te relire

Le 19/12/2013 à 11:54

Mokay,

L'opération n'est pas énorme.

Le but de mon fichier archivage, est d'archiver mes création d'offres.

J'ai des demandes qui émanent de plusieurs clients pour des affaires identiques.

Je devais inventer un système qui permet de copier une offre déjà remplie à un client pour la renommer à une demande d'un autre client.

Ainsi est le but de la macro "new_ligne" (si tu es sur l'onglet 2013) ou "new_ligne_14" (sur l'onglet 2014).

Déroulement :

Etape 1 : simplement sélectionner une cellule sur la ligne qui correspond à l'offre que nous voulons recopier. Cela importe peu la cellule choisie tant qu'elle se trouve sur la ligne à atteindre.

Etape 2 : Cliquer sur le bouton "Copier Offre" (macro new_ligne sur onglet 2013)

La macro insert une nouvelle ligne en y ajoutant dans la 1ère colonne le même numéro d'offre suivit d'un ".1" (de ce fait, je puis recopier une offre jusqu'à l'infinie).

Etape 3 : l'UserForm apparait, on y remplit les champs avec les références de notre nouveau demandeur.

Etape 4 : Clic "OK"

Alors bien entendu, le bug apparait à cet instant. La suite vous la connaissez...

Puis je force le déroulement (F5)

La suite : la macro ouvre le fichier existant ("nomfichier2"), le manipule pour y insérer les modifications tapée dans l'UserForm, Créer les divers répertoires du nouveau client, et sauvegarde le nouveau fichier. Tout ça c'est impecc.

J'espère que cela est clair... Je puis fournir le fichier offre base par mp...

Le 19/12/2013 à 14:54

Plop, après plusieurs essais, j'ai trouvé une solution du genre "pas piqué des hanneton";

J'ai ajouté un MsgBox

MsgBox "Ouverture du fichier " & nomfichier2 & ""

juste avant le

Workbooks.Open Filename:=nomfichier2

, cela crée une petite pause et du coup le bug n'apparait plus.

Comprends pas tout, juste une petite intuition sur le temps d'exécution qui met en échec le Workbooks.Open...

Woala, c'est tout pour le moment.

Le 20/12/2013 à 11:53

re,

Merci pour tes excellentes explications et très claires

Je vois que tu cloturer le fil mais si tu reviens essai en modifiant le code comme ceci :

Sub new_ligne()
'Modif dan
Application.ScreenUpdating = False
Dim lg As Integer
lg = ActiveCell.Row
Range("A" & lg + 1).EntireRow.Insert
Range("A" & lg & ":AI" & lg).Copy
Range("A" & lg + 1).PasteSpecial Paste:=xlPasteAll
Application.CutCopyMode = False
Range("B" & lg + 1 & ":D" & lg + 1).ClearContents
Range("H" & lg + 1 & ":I" & lg + 1).ClearContents
Range("AA" & lg + 1 & ":AF" & lg + 1).ClearContents
Range("AF" & lg + 1) = Range("AF" & lg) + 0.1
UserForm1.Show
ActiveWorkbook.Save
Range("A" & lg).Copy
nomfichier2 = Range("AE" & lg).Value
Workbooks.Open Filename:=nomfichier2
...

J'ai vu qu'il y a encore d'autre chose à modifier mais bon pas à pas et voir si cela t'intéresse

Amicalement

Le 22/12/2013 à 12:31

Merci Dan, je suis en vacances pour les 2 semaines à venir. Je testerai ton code à mon retour. En tout cas, merci d'y avoir consacré du temps. De bonnes fêtes de fin d'année et à bientôt.

:edit:

J'ai testé ton code et apparemment cela fonctionne en partie.

En ce qui concerne le fichier archive, tout se passe à merveille, mais le code n'applique plus le reste

(création des répertoires et mise à jour des données sur le fichier "offre").

Mais comme tu le dis précédemment, c'est à creuser.

Alors je le garde sous le coude. Merci de ta participation et bonne année 2014 !!

Rechercher des sujets similaires à "userform bug listes deroulantes"