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

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

1707490081109.png


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...

Zonmé

XLDnaute Nouveau
@Zonmé

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

Regarde la pièce jointe 1190353

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 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,D49,C51,C53,C56,C58,C60,C62").ClearContents
Case 7 'Non
    ActiveSheet.Range("B74: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,D49,C51,C53,C56,C58,C60,C62").ClearContents
Case 2 'Annuler
Retour = MsgBox("Vou pouvez encore choisir de ne rien copier ?" & Chr(13) & Chr(10) & _
        "Ok ==> On copie les 2 options" & Chr(13) & Chr(10) & _
        "Annuler ==> On ne  copie rien et l'oprération est annulée", vbOKCancel, "Annulation ou copier !")
    If Retour = 1 Then ' Ok
        ActiveSheet.Range("B74: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,D49,C51,C53,C56,C58,C60,C62").ClearContents
    Else
        [B34].Select
    End If
        [B15].Select
End Select
End Sub

Ce code correspond au bouton ;)
Regarde la pièce jointe 1190354
Sur le même principe tu peux faire le 2eme bouton si tu n'y arrives pas je le ferais

Je te laisse mettre les messages en anglais sinon tu vas trop rire ..... ! 🤣

Ne pas oublier de faire une copie de sauvegarde avant .....au cas ou....... :rolleyes:
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++
 

Zonmé

XLDnaute Nouveau
Baah, franchement merci beaucoup Phil. Je vais tester ça l'esprit clair Lundi matin, mais ça à l'air top!
Je te tiens au courant, et encore merci pour ton temps et ta disponibilité, le top du top.
a+++
@Zonmé

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

Regarde la pièce jointe 1190353

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 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,D49,C51,C53,C56,C58,C60,C62").ClearContents
Case 7 'Non
    ActiveSheet.Range("B74: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,D49,C51,C53,C56,C58,C60,C62").ClearContents
Case 2 'Annuler
Retour = MsgBox("Vou pouvez encore choisir de ne rien copier ?" & Chr(13) & Chr(10) & _
        "Ok ==> On copie les 2 options" & Chr(13) & Chr(10) & _
        "Annuler ==> On ne  copie rien et l'oprération est annulée", vbOKCancel, "Annulation ou copier !")
    If Retour = 1 Then ' Ok
        ActiveSheet.Range("B74: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,D49,C51,C53,C56,C58,C60,C62").ClearContents
    Else
        [B34].Select
    End If
        [B15].Select
End Select
End Sub

Ce code correspond au bouton ;)
Regarde la pièce jointe 1190354
Sur le même principe tu peux faire le 2eme bouton si tu n'y arrives pas je le ferais

Je te laisse mettre les messages en anglais sinon tu vas trop rire ..... ! 🤣

Ne pas oublier de faire une copie de sauvegarde avant .....au cas ou....... :rolleyes:

Baah, franchement merci beaucoup Phil. Je vais tester ça l'esprit clair Lundi matin, mais ça à l'air top!
Je te tiens au courant, et encore merci pour ton temps et ta disponibilité, le top du top.
a+++

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 :D!

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")?
 

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" ;)
 

Zonmé

XLDnaute Nouveau
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" ;)
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:

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:

Discussions similaires

Réponses
9
Affichages
226
Réponses
0
Affichages
137
Réponses
4
Affichages
238

Statistiques des forums

Discussions
312 561
Messages
2 089 658
Membres
104 248
dernier inscrit
pegaso