Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 Code VBA pour choisir entre deux options précalculées dans un classeur

Z

Zonmé

XLDnaute Nouveau
Bonjour à tous, j'ai souvent eu l'occasion d'utiliser ce forum pour trouver réponse à mes questions autour des codes VBA, mais aujourd'hui je bloque et en appelle à vos connaissances!
J'ai créé un fichier excel assez lourd, limite usine à gaz, pour calculer des quantités de produits nécessaires à des projets, en offrant deux options de produits dans la phase de construction du devis en fonction des caractéristiques du projet détaillée sur la même feuille, mais calculées sur d'autre feuilles cachées aux utilisateurs.
J'ai déjà pas mal de macros qui tournent, dont une qui reprend la liste de produits établis sur la feuille 1 et la reporte sur la demande de devis en feuille 2 (la liste d'achat), avec un message d'alerte du type "êtes-vous sur de vouloir rajouter ces produits à votre liste d'achat?".
Cela fonctionne plutôt pas mal, mais par contre je ne trouve pas comment inclure une étape pour choisir entre les deux options proposées par ma feuille de calcul et ainsi n'afficher que la ligne de l'option choisie pour la reporter sur la liste d'achat, sans pour autant effacer les formules de calcules des deux options proposées.
Ce n'est peut être pas très clairement expliqué, mais je me tiens à votre disposition pour plus de renseignement, voire essayer de créer une version simplifié du tableau sans les données confidentielles qu'il contient.
Merci d'avance,
Cédric
 
Dernière édition:
Solution
@Zonmé

Je te propose ce code en remplacement et tu remplaces uniquement cette partie



VB: 
Sub AjouterProduits()
Dim Retour As Integer
Retour = MsgBox("Quelle option voulez vous garder ?" & Chr(13) & Chr(10) & _
        "Oui ==> L'option 1" & Chr(13) & Chr(10) & _
        "Non ==> L'option 2" & Chr(13) & Chr(10) & _
        "Annuler ==> On garde les 2", vbYesNoCancel, "Choisir option !")
Select Case Retour
Case 6 'Oui
    ActiveSheet.Range("B74:I77").Copy
    With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
        .PasteSpecial Paste:=xlPasteColumnWidths
        .PasteSpecial Paste:=xlPasteValues
    End With
    ActiveSheet.Range("B79:I93").Copy
    With Sheets("Product...
Trier par date Trier par votes
Z

Zonmé

XLDnaute Nouveau
Bonjour Phil,
franchement ilmpressionnant!
On est pas loin du truc là, et surtout tes doubles pop ups m'ont permis de mieux cerné mon besoin.
En gros je vais avoir deux situation: avec un film en stock ou sans . Cela est précisé en ligne C30 et C69. Si j'en ai un, il apparait toujours en ligne 76. Dans ce cas là, j'aurais besoin des 3 possibilités: Option 1 (qui sera en ligne 77); Option 2 (ligne 78), et "Aucune" donc ça ne copierai que la igne 76.
Si je n'ai pas de film en stock, juste l'option 1 (avec les données en ligne 76 du coup) et 2 (ligne 77), sans autre possibilité.
J'ai fait des tests déjà, mais n'ai pas réussi à adapter le code.. Par contre ça m'a permis de voir que justement si je n'ai pas de film en stock, cela me décale les lignes copiées entre option 1 et 2) .
Voila, je ne sais pas si mon explication est claire, mais en tout cas on avance super bien.

Egalement deux petite question, tu saurais me donner la ligne de commande pour sauvegarder le pdf final sur le bureau ou dans le dossier téléchargement?

Egalement pour les pop-up, il y a t il possibilité de faire un concatner du style: "Oui - Option 1 ";contenu colonne E;" wide film"?
A ta dispo, et je pense au tag de résolution aussi!
a++
 
Vote positif 0 Vote négatif
Z

Zonmé

XLDnaute Nouveau

Bonjour @Phil69970 , je ne sais pas pourquoi ma réponse précédente à disparue.

Merci, c'est vraiment impressionnant ce que tu as fait en quelques minutes!

Tes messages avec choix d'options sont super, et du coup m'ont permis de mieux cerner mon besoin.

J'ai essayer d'apater sans succès ton code pour en fait avoir deux configuration de choix, suivant si on a selectionné et indiqué que l'on avait du film en stock (cellules C30 et C68 de la feuille 1):
Configuration A: J'ai du film en stock, et je choisis entre Oui - Option 1 (ligne 77) ; Non - Option 2 (ligne 78); Annuler - aucun des deux (mais prendra par defaut celui en stock ligne 76). Si je n'ai pas de film en srtock j'aimerai avoir le choix en Oui - Option 1 (ligne 76 dans ce cas là) et Non - Option 2 (ligne 77), sans avoir besoin de laisser le choix ensuite entre ajouter les deux options ou auncun des produits

Acutellement quand je n'ai pas de film en stock et que je choisis l'option 2, il va trouver une valeur vide mais conservera l'option 1 en ligne 76.
J'abuse un peu je sais !

Et quitte à le faire j'aurais deux autre questions: as-tu pu voir la ligne de commande à rajouter pour soit choisir l'emplacement de sauvegarde du pdf?
Dans les fenetres que tu m'a créer, as-tu un sorte de concatener VBA pour aapeter le contenu de la msgbox avec queqlue chose du type: Oui = CONCATENER("Option 1 - ";Celulle E77 ou E76 selon les cas," mm wide film")?
 
Vote positif 0 Vote négatif

Phil69970

XLDnaute Barbatruc
Bonjour @Zonmé

J'étais absent toute la journée et sur le forum en pointillé tout la semaine....
A priori tu batailles pour avoir un/des message(s) cohérent avec la copie en rapport de la réponse. de l'utilisateur ?

Je t'avais fait 4 choix : (les 3 rouge et le bleu)

L'utilisateur réponds ==> Oui je copie les lignes B74 à I77 puis je copie les lignes B79 à I93 à la suite en clair je zappe la ligne 78 comme si elle n'existe pas ...

L'utilisateur réponds ==> Non c'est le contraire je copie les lignes B74 à I76 puis je copie les lignes B78 à I93 à la suite en clair je zappe la ligne 77 comme si elle n'existe pas ...

L'utilisateur réponds ==>Annuler Il à droit à un 2eme message lui laissant le choix soit de tout copier B74 à B93 soit de tout annuler et de ne rien copier

Maintenant si j'ai compris tu ne veux que les 3er choix rouge et pas le choix bleu

Sinon explique ce que tu veux comme message .....

Les "select case" permet plus de souplesse et très souvent est plus rapide que des "if .... then"
 
Vote positif 0 Vote négatif
Z

Zonmé

XLDnaute Nouveau
Salut @Phil69970 , comment vas-tu?
En fait la structure même de mon tableau fait que j'ai deux configurations possibles:
A - Film en stock - Cellule C30 feuille 1 = Yes
B - Pas de film - C30 = No
Du coup suivant cette valeur, j'aurais besoin d'une fenêtre pop up avec soit:
A - Oui: Copie Ligne 77 (Option A) ET ligne 76 (film en stock)
Non: Copie ligne 78 (Option B) ET ligne 76 (film en stock)
Annuler: Copie uniquement la ligne 76 (film en stock)

B - Oui: Copie ligne 76 (Option A)
Non: Copie ligne 77 (Option B)

Je suis chiant je sais ahaha!
Par contre pour ce qui est de l'enregistrement, c'est bon, j'ai réussi. J'avais un problème avec mes enchainements en fait:
VB: 
Sub MasquerRfQPres()
Debut = 1
Fin = 53
ColNb = 1
For i = Debut To Fin
If Cells(i, ColNb).Value = "" Then
Cells(i, ColNb).EntireRow.Hidden = True
Else
Cells(i, ColNb).EntireRow.Hidden = False
End If
Next i
With Worksheets("My RfQ")
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
            chemin = .SelectedItems(1) & "\"
        End If
    End With
    ActiveSheet.Range("B1:H53").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                                                    chemin & ActiveSheet.Range("C54").Value, OpenAfterPublish:=True
    End With
 MsgBox "Your request has been saved in PDF format."
 Application.Goto [B1], True
End Sub
Idem pour le "Concatener" que je pourrais réadapter ensuite:
VB: 
Sub AjouterProduits()
Dim Retour As Integer
Retour = MsgBox("What film option do you want to add to your RfQ" & Chr(13) & Chr(10) & _
        "Option 1 - " & ActiveSheet.Range("E77").Value & "mm wide film" & Chr(13) & Chr(10) & _
        "Option 2 - " & ActiveSheet.Range("E78").Value & "mm wide film" & Chr(13) & Chr(10) & _
        "None - Just add the same model I have in stock", vbYesNoCancel, "Please select your film option")
Select Case Retour
Case 6 'Oui

Je ne connaissais pas les select case je t'avoue, et je ne comprends pas vraiment le mécanisme. Commet tu définie par exemple du ton case 6 (oui) renvoie la bonne ligne suivant option A ou B?

Je ne sais pas utiliser et avoir la bonne syntaxe, mais dans l'esprit il faudrait un Case à deux niveaux
 
Dernière édition:
Vote positif 0 Vote négatif
Z

Zonmé

XLDnaute Nouveau
Dans l'idée ,e voudrais ça, j'ai essayé un mix entre If Else et Select Case, mais ça ne marche pas...
J'i un message d'erreur de compilation "Else sans If":
VB: 
Sub AjoutProd()
Dim Stock       As Integer
Dim Retour      As Integer
Dim Retour2     As Integer
Stock = ActiveSheet.Range(C30).Value
If Stock = Yes Then
        Retour = MsgBox("What film Option Do you want To add To your RfQ" & Chr(13) & Chr(10) & _
                 "Option 1 - " & ActiveSheet.Range("E77").Value & "mm wide film" & Chr(13) & Chr(10) & _
                 "Option 2 - " & ActiveSheet.Range("E78").Value & "mm wide film" & Chr(13) & Chr(10) & _
                 "My Film - " & ActiveSheet.Range("E76").Value & "mm wide film in stock", vbYesNoCancel, "Please Select your film option")
        Select Case Retour
            Case 6        'Oui
                ActiveSheet.Range("B76:I77").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("B79:I93").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("C18").Copy
                With Sheets("Product List").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteValues
                End With
                Range("C16,C18,C20,C22,C24,C26,C28,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
            Case 7        'Non
                ActiveSheet.Range("B76:I76").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("B78:I93").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("C18").Copy
                With Sheets("Product List").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteValues
                End With
                Range("C16,C18,C20,C22,C24,C26,C28,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
            Case 2        'Annuler
                ActiveSheet.Range("B76:I76").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("B79:I93").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("C18").Copy
                With Sheets("Product List").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteValues
                End With
                Range("C16,C18,C20,C22,C24,C26,C28,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
Else
        Retour2 = MsgBox("What film Option Do you want To add To your RfQ" & Chr(13) & Chr(10) & _
                  "Option 1 - " & ActiveSheet.Range("E77").Value & "mm wide film" & Chr(13) & Chr(10) & _
                  "Option 2 - " & ActiveSheet.Range("E78").Value & "mm wide film" & Chr(13) & Chr(10) & _
                  vbYesNo, "Please Select your film option")
        Select Case Retour2
            Case 6        'Oui
                ActiveSheet.Range("B76:I76").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                   .PasteSpecial Paste:=xlPasteColumnWidths
                   .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("B79:I93").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                   .PasteSpecial Paste:=xlPasteColumnWidths
                   .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("C18").Copy
                With Sheets("Product List").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteValues
                End With
                Range("C16,C18,C20,C22,C24,C26,C28,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
            Case 7        'Non
                ActiveSheet.Range("B77:I77").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("B79:I93").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("C18").Copy
                With Sheets("Product List").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteValues
                End With
                Range("C16,C18,C20,C22,C24,C26,C28,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
End If
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

M
  • Résolu(e)
XL 2010 Nature du type de prix de la facture
Réponses
3
Affichages
278
Mody200
M
V
  • Question
Microsoft 365 VBA deux document Excel
Réponses
10
Affichages
452
vroumvroum
V
M
  • Question
XL 2019 étirer liste déroulante
Réponses
10
Affichages
453
milckush
M
E
  • Question
XL 2021 Enlever le bouton (vide) dans un segment
Réponses
0
Affichages
721
Eliot4
E
D
  • Résolu(e)
Microsoft 365 lier deux colonnes selon une liste de distribution dans un premier fichier
2
Réponses
16
Affichages
581
Daniel200666
D
D
  • Question
XL 2019 Bouton VBA
Réponses
3
Affichages
328
sylvanu
Y
  • Question
XL 2013 Reprise d'une colonne dans un TCD
Réponses
4
Affichages
412
Yvan1
Y
B
  • Question
XL 2021 Problème VBA
Réponses
8
Affichages
474
Bensi
B
C
  • Question
Microsoft 365 Problème Code VBA
Réponses
9
Affichages
369
fanch55
J
  • Résolu(e)
XL 2021 Aide code VBA - à partir de deux listes, créer une base de donnée
2
Réponses
22
Affichages
885
merinos-BernardEtang
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…