XL 2016 Exporter Graphique sur nouveau classeur

  • Initiateur de la discussion Initiateur de la discussion KTM
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

KTM

XLDnaute Impliqué
Bonjour chers tous
Jai un fichier sur lequel jai une feuille qui contient les tables de données et une feuille sur laquelle les graphiques afférents sont construits.
Jai associé un bouton à chaque graphique qui offre le choix entre copier le graphique sur un nouveau classeur et copier seulement la table de données liée au graphique.

Jai fait un début de macro et je sollicite votre aide pour finir le paramétrage merci..
VB:
Sub exporter()

Dim choix
If MsgBox("Exporter ? ", vbYesNo + 32) = vbNo Then Exit Sub
choix = InputBox("Données à Copier: " & Chr(10) & Chr(13) & _
"  1- Graphique" & Chr(10) & Chr(13) & _
"  2- Base de Données", "Exportation")

If choix = "" Then
Exit Sub
ElseIf Not IsNumeric(choix) Or choix < 1 Or choix > 2 Then
MsgBox " Mauvais Choix ", 48
Exit Sub
Else
    If choix = 1 Then
    'Exporter Graphique
    ElseIf choix = 2 Then
    'Exporter les données du graphique
    End If
End If
End Sub
 

Pièces jointes

Bonsoir @job75


VB:
Sub Export()
Dim FeuilSource As Worksheet
    Set FeuilSource = ThisWorkbook.Worksheets(ActiveSheet.Name)
Dim colRefs As New Collection
 ' Les données Stoké en Static dans la FeuilSource Excel : Formule / Gestionaire de nom
    colRefs.Add Key:="BCG Graph", Item:=FeuilSource.Range("A2:F16")
    colRefs.Add Key:="BCG Tableau", Item:=FeuilSource.Range("A3:C8")
    colRefs.Add Key:="VAR Graph", Item:=FeuilSource.Range("A17:F31")
    colRefs.Add Key:="VAR Tableau", Item:=FeuilSource.Range("A11:C16")
Dim rngSource As Range
    Set rngSource = colRefs(CStr(ActiveSheet.DrawingObjects(Application.Caller).Text))
With Workbooks.Add(xlWBATWorksheet) 'feuille de calcul
    .Sheets(1).Name = FeuilSource.Name
     rngSource.Copy Destination:=.Sheets(1).[A1] 'copier-coller
    .UpdateLinks = xlUpdateLinksAlways 'évite le message de mise à jour des liens à l'ouverture
    .SaveAs ThisWorkbook.Path & "\" & FeuilSource.Name & ".xlsx"
    .Close
End With
MsgBox "Le fichier '" & FeuilSource.Name & ".xlsx' a été créé..."
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
9
Affichages
339
Réponses
7
Affichages
415
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
880
Retour