XL 2016 Ajouter un nouveau classeur

isabelle29

XLDnaute Nouveau
Bonjour,
S'il vous plait est ce que c'est possible à partir d'un fichier "test1" d'ajouter un nouveau classeur "test2" et créer un bouton puis inséré dans ce bouton un code sans exécuter ce code
alors si on ouvre le fichier test2 on trouve un bouton avec un code vba.
ce code en dessous marche bien mais le code exécuter lors de la création du bouton ne mrche pas

Workbooks.Add
ActiveSheet.Buttons.Add.Select
Selection.OnAction = ActiveWorkbook.ActiveSheet.Rows("1:1").Select
ActiveWorkbook.SaveAs Filename:=chemin & "test2.xls"
 

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

Ci-joints, deux classeurs.
1 - ClasseurMaître.xlsm à ouvrir et qui contient un bouton ('Nouveau classeur test').
2 - test.xltm (renomer en test.zip car xld n'accepte pas l'upload des fichier xltm) modèle de classeur avec macro et bouton (à mettre dans le même répertoire que le ClasseurMaître.xlsm)

Renommez test.zip en test.xltm puis ouvrez le ClasseurMaître.xlsm et cliquez sur son bouton.
L'avantage est que vous pouvez à partir d'un modèle créer autant de classeur souhaités qui seront nommés avant enregistrement 'test1', 'test2' etc...


Si ce procédé ne convient pas vous pouvez également voir du côté de ActiveWorkbook.SaveCopyAs pour faire une copie du classeur actif.

Cordialement
 

Pièces jointes

  • ClasseurMaître.xlsm
    16.6 KB · Affichages: 4
  • test.zip
    17.1 KB · Affichages: 3

isabelle29

XLDnaute Nouveau
Bonjour Roblochon,
Merci de votre réponse mais je n'ai pas bien compris votre solution en revanche dans mon cas je commence avec un seul fichier classeur maitre
et à travers ce fichier il y une macro qui ajoute un fichier test et dans ce fichier test jaimerai bien qu'il y aura un bouton avec ce code
ActiveSheet.Rows(1).EntireRow.Select
C-à-d un macro pour créer un classeur qui contient un macro
j'espère que jai bien expliqué le cas
Cordialement
 

Hasco

XLDnaute Barbatruc
Repose en paix
Re,

C'est ce que contient le fichier test.xltm.
Avez vous testé et regarder les macros qui sont dans les deux classeurs.
Dans votre macro qui "ajoute un fichier test " au lieu "d'ajouter un classeur (fichier) vide" ajoutez un classeur modèle (test.xltm), qui sera également vide à part un bouton et une macro qui fonctionnera.

Si vous ne comprenez pas comment faire, joignez un exemple amaigri de votre "Classeur Maître" et du classeur test qu'il faut créer.

Bien cordialement
 

job75

XLDnaute Barbatruc
Bonjour isabelle29, Roblochon, le forum,

On peut aussi utiliser une feuille Modèle et exécuter ce code dans le fichier joint :
VB:
Sub NouveauFichier()
Dim chemin$, fichier$, vis
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = "Fichier " & Format(Date, "yyyy-mm-dd") 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Sheets("Modèle")
    vis = .Visible
    .Visible = xlSheetVisible 'si masquée
    .Copy 'nouveau document
    .Visible = vis
End With
With ActiveWorkbook
    .Sheets(1).Name = fichier
    .Sheets(1).Shapes(1).OnAction = "'" & .Name & "'!" & .Sheets(1).CodeName & ".Macro"
    .SaveAs chemin & fichier, 56 'fichier .xls
    .Close
End With
End Sub
La feuille Modèle contient le bouton et sa macro, elle peut être masquée.

A+
 

Pièces jointes

  • Nouveau fichier(1).xlsm
    28.3 KB · Affichages: 4
Dernière édition:

job75

XLDnaute Barbatruc
Avec ce fichier (2) on se passe de modèle :
VB:
Sub NouveauFichier()
Dim chemin$, fichier$, wb As Workbook
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = "Fichier " & Format(Date, "yyyy-mm-dd") 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wb = Workbooks.Add(xlWBATWorksheet) 'nouveau document
wb.Sheets(1).Name = fichier
With wb.VBProject
    .VBComponents.Add 1 'ajout d'un module standard
    .VBComponents("Module1").CodeModule.AddFromString _
        "Sub Macro()" & vbCrLf & "ActiveWorkbook.ActiveSheet.Rows(1).Select" & vbCrLf & "End Sub"
End With
With wb.Sheets(1).Buttons.Add(0, 0, 80, 30) 'ajout d'un bouton
    .Text = "Macro"
    .Font.Bold = True 'gras
    .OnAction = "'" & wb.Name & "'!Macro"
End With
wb.SaveAs chemin & fichier, 56 'fichier .xls
wb.Close
End Sub
Mais attention, pour que l'accès au VBAProject soit possible par macro il faut avoir coché l'option :

- sur Excel 2003 et versions antérieures Faire confiance au projet Visual Basic (menu Outils-Macro-Sécurité-Editeurs approuvés)

- sur Excel 2007 et versions suivantes Accès approuvé au modèle d'objet du projet VBA (onglet Fichier-Options-Centre de gestion de la confidentialité-Paramètres...-Paramètres des macros).

A+
 

Pièces jointes

  • Nouveau fichier(2).xlsm
    24.7 KB · Affichages: 4

isabelle29

XLDnaute Nouveau
Bonjour job75,
Merci de vos réponse , votre code fonctionnement parfaitement .Alors pour aller un petit peu loin, comment s'il vous plait on peut rajouter ce code en dessous :
VB:
Sub graphbarre()

    Dim groupe As Integer
    groupe = Range("B2").Value
    Dim numero_graph As Integer
    numero_graph = Range("B5").Value
    Dim nom_graph As String
    Sheets("g 1").Select
    nom_graph = Range("b" & (numero_graph)).Value
    Sheets("2").Select
    Dim K As Integer
          
    Charts.Add
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Sheets("2").Range("D5") '='g 1'!$C$2:$N$2
    
    For K = 1 To groupe
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(K).Values = "='g " & K & "'!R" & (numero_graph) & "C2:R" & (numero_graph) & "C13"
    ActiveChart.SeriesCollection(K).Name = "g " & K
    ActiveChart.SeriesCollection(1).XValues = "=2!R1C6:R1C17"
        Next K
    
    ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=nom_graph
    With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = nom_graph
        .Axes(xlCategory, xlPrimary).HasTitle = False
        .Axes(xlValue, xlPrimary).HasTitle = False
    End With
    ActiveChart.PlotArea.Select
    With Selection.Border
        .ColorIndex = 16
        .Weight = xlThin
        .LineStyle = xlContinuous
    End With
    With Selection.Interior
        .ColorIndex = 2
        .PatternColorIndex = 1
        .Pattern = xlSolid
    End With
End Sub
au lieu de celui ci "Sub Macro()" & vbCrLf & "ActiveWorkbook.ActiveSheet.Rows(1).Select" & vbCrLf & "End Sub"
 

job75

XLDnaute Barbatruc
Bonjour isabelle29,

On ne voit pas trop l'intérêt de créer un fichier avec la macro graphbarre mais bon...

Voyez ce fichier (3) et cette macro qui utilisent la feuille Modèle de mon post #6 :
VB:
Sub NouveauFichier()
Dim chemin$, fichier$, vis
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = "Fichier " & Format(Date, "yyyy-mm-dd") 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Sheets("Modèle")
    vis = .Visible
    .Visible = xlSheetVisible 'si masquée
    .Copy 'nouveau document
    .Visible = vis
End With
With ActiveWorkbook
    .Sheets(1).Name = fichier
    .Sheets(1).[B2] = 1 'numéro modifiable
    .Sheets(1).[B5] = 1 'numéro modifiable
    .Sheets(1).Shapes(1).OnAction = "'" & .Name & "'!" & .Sheets(1).CodeName & ".graphbarre"
    .Sheets.Add After:=.Sheets(1)
    .Sheets(2).Name = "g 1"
    .Sheets(2).Range("B" & .Sheets(1).[B5]) = "MonGraph"
    .Sheets.Add After:=.Sheets(2)
    .Sheets(3).Name = "2"
    .Sheets(1).Select
    .SaveAs chemin & fichier, 56 'fichier .xls
    .Close
End With
End Sub
A+
 

Pièces jointes

  • Nouveau fichier(3).xlsm
    30.7 KB · Affichages: 9

Discussions similaires

Statistiques des forums

Discussions
311 721
Messages
2 081 928
Membres
101 842
dernier inscrit
seb0390