XL 2013 Création bouton de copie

Kath · 12 Décembre 2018

Hello tout le monde, j'ai besoin de votre aide
En fait j'ai un classeur avec des onglets numérotés de 01 à 31

et j'aimerai que sur chaque feuille il y'ait un bouton qui copie la feuille précédente sans copier les cellules H2 et H3.
Pourriez vous m'aider svp!
D'avance Merci

Kath · 12 Décembre 2018

job75 à dit:
Re, salut vmax01,

Le titre de ce fil c'est Création bouton de copie non ???

Alors voyez le fichier joint avec ces 2 macros dans ThisWorkbook et Module1 :

Code:

Private Sub Workbook_Open() Dim w As Worksheet, o As Object For Each w In Worksheets If w.Name Like "##" Then For Each o In w.DrawingObjects If o.OnAction Like "*MAJ" Then GoTo 1 Next With w.[E2:E3] With w.Buttons.Add(.Left, .Top, .Width, .Height) .Text = "MAJ" .Font.Bold = True 'gras .OnAction = "MAJ" End With End With End If 1 Next End Sub

Code:

Sub MAJ() Dim prem$, mem, o prem = "30.11.18" 'à adapter With ActiveSheet If Not .Name Like "##" Then Exit Sub mem = .[H2:H3].Formula Application.ScreenUpdating = False For Each o In .DrawingObjects If o.TopLeftCell.Address <> "$E$2" Or .Name <> "01" Then o.Delete 'suppression des objets Next Sheets(IIf(.Name = "01", prem, Format(Val(.Name) - 1, "00"))).Cells.Copy .[A1] 'copie les cellules et les objets .[H2].Copy .[H2] 'vide la mémoire .[H2:H3] = mem End With End Sub

Les boutons sont créés à l'ouverture du fichier dans chaque feuille quand ils n'existent pas.

La macro MAJ leur est affectée.

A+[/QUOTE
Wouah en fait je n'étais pas prête de m'en sortir je te remercie pour ce super travail c'est ce qu'il me fallait avec le bouton et tout super cool merci beaucoup

Kath · 12 Décembre 2018

vmax01 à dit:
desolé Job75 et bonjour nos messages se sont croisés....

Merci Vmax pour ton travail aussi c'est super sympa et désolé du dérangement un grand merci à toi

Kath · 12 Décembre 2018

Vmax j'ai un autre soucis le code vba ne prends pas en compte l'image du logo de la cellule A1?
Que dois je rajouter stp?

Kath · 12 Décembre 2018

job75 à dit:

Re, salut vmax01,

Le titre de ce fil c'est Création bouton de copie non ???

Alors voyez le fichier joint avec ces 2 macros dans ThisWorkbook et Module1 :

Code:

Private Sub Workbook_Open()
Dim w As Worksheet, o As Object
For Each w In Worksheets
    If w.Name Like "##" Then
        For Each o In w.DrawingObjects
            If o.OnAction Like "*MAJ" Then GoTo 1
        Next
        With w.[E2:E3]
            With w.Buttons.Add(.Left, .Top, .Width, .Height)
                .Text = "MAJ"
                .Font.Bold = True 'gras
                .OnAction = "MAJ"
            End With
        End With
    End If
1 Next
End Sub

Code:

Sub MAJ()
Dim prem$, mem, o
prem = "30.11.18" 'à adapter
With ActiveSheet
    If Not .Name Like "##" Then Exit Sub
    mem = .[H2:H3].Formula
    Application.ScreenUpdating = False
    For Each o In .DrawingObjects
        If o.TopLeftCell.Address <> "$E$2" Or .Name <> "01" Then o.Delete 'suppression des objets
    Next
    Sheets(IIf(.Name = "01", prem, Format(Val(.Name) - 1, "00"))).Cells.Copy .[A1] 'copie les cellules et les objets
    .[H2].Copy .[H2] 'vide la mémoire
    .[H2:H3] = mem
End With
End Sub

Les boutons sont créés à l'ouverture du fichier dans chaque feuille quand ils n'existent pas.

La macro MAJ leur est affectée.

A+[/QUOTE

job75 à dit:

Re, salut vmax01,

Le titre de ce fil c'est Création bouton de copie non ???

Alors voyez le fichier joint avec ces 2 macros dans ThisWorkbook et Module1 :

Code:

Private Sub Workbook_Open()
Dim w As Worksheet, o As Object
For Each w In Worksheets
    If w.Name Like "##" Then
        For Each o In w.DrawingObjects
            If o.OnAction Like "*MAJ" Then GoTo 1
        Next
        With w.[E2:E3]
            With w.Buttons.Add(.Left, .Top, .Width, .Height)
                .Text = "MAJ"
                .Font.Bold = True 'gras
                .OnAction = "MAJ"
            End With
        End With
    End If
1 Next
End Sub

Code:

Sub MAJ()
Dim prem$, mem, o
prem = "30.11.18" 'à adapter
With ActiveSheet
    If Not .Name Like "##" Then Exit Sub
    mem = .[H2:H3].Formula
    Application.ScreenUpdating = False
    For Each o In .DrawingObjects
        If o.TopLeftCell.Address <> "$E$2" Or .Name <> "01" Then o.Delete 'suppression des objets
    Next
    Sheets(IIf(.Name = "01", prem, Format(Val(.Name) - 1, "00"))).Cells.Copy .[A1] 'copie les cellules et les objets
    .[H2].Copy .[H2] 'vide la mémoire
    .[H2:H3] = mem
End With
End Sub

Les boutons sont créés à l'ouverture du fichier dans chaque feuille quand ils n'existent pas.

La macro MAJ leur est affectée.

A+

job75 à dit:
Bonjour Kath, bienvenue sur XLD,

Si l'on met un bouton dans l'onglet '01' il doit copier quoi ???

A+

Job75 est ce possible de créer les onglets avec le tableau et le logo uniquement dans un premier temps?
Et d'ajouter en N12 une fois toutes les feuilles faites, le bouton MAJ ?
J'ai essayé de trafiquer tes codes mais je me suis vite perdue

job75 · 12 Décembre 2018

Désolé mais ce n'est pas le problème posé au post #1.

Et créer 31 onglets manuellement de toute façon ce n'est pas la mer à boire...

vmax01 · 13 Décembre 2018

bonjour Kath, job75 et le forum

change le code actuel pas celui-là en sachant qu'il va falloir renommer le nom "shapes" dans le code pare le nom de te ton logo pour que cela soit pris en compte

Code:

Sub MB()
Application.ScreenUpdating = False
For jour = DateSerial(Year(Date), Month(Date), 1) To DateSerial(Year(Date), Month(Date) + 1, 0)
    Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = Format(jour, "dd")
    Sheets("modele").Cells.Copy
    Cells.PasteSpecial
    Sheets("modele").Shapes("Image A DEFINIRE").Copy
    [A1].PasteSpecial
    Cells(2, 8) = "Date"
    Cells(3, 8) = Format(jour, "mm/dd/yyyy")
Next jour
Application.ScreenUpdating = True
' ActiveWorkbook.Save
End Sub

Bonne journée.

job75 · 13 Décembre 2018

Bonjour Kath, vmax01,

Bon puisqu'on pousse à la consommation voyez le fichier (2) et cette macro :

Code:

Sub CreationMois()
Dim mois$, w As Worksheet, F As Worksheet, vis, n
Do
    mois = InputBox("Numéro du mois et année du mois à créer :", "Création du mois", Format(Date, "m/yy"))
    If mois = "" Then Exit Sub
Loop While Not IsDate("1/" & mois)
mois = "1/" & mois
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'---RAZ---
For Each w In Worksheets
    If w.Name Like "##" Then w.Delete
Next
'---création des feuilles---
Set F = Sheets("modele")
vis = F.Visible
F.Visible = xlSheetVisible 'si la feuille est masquée
Application.Goto F.[A1], True 'cadrage
For n = 1 To Day(DateSerial(Year(mois), Month(mois) + 1, 0))
    F.Copy After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = Format(n, "00")
    Sheets(Sheets.Count).[H3] = DateSerial(Year(mois), Month(mois), n)
Next
F.Visible = vis 'état initial
Sheets("Accueil").Activate
End Sub

La feuille modele est masquée et j'ai ajouté la feuille Accueil.

J'ai laissé les autres macros mais la création des boutons "MAJ" paraît assez peu utile...

A+

Kath · 13 Décembre 2018

vmax01 à dit:
bonjour Kath, job75 et le forum

change le code actuel pas celui-là en sachant qu'il va falloir renommer le nom "shapes" dans le code pare le nom de te ton logo pour que cela soit pris en compte

Code:

Sub MB() Application.ScreenUpdating = False For jour = DateSerial(Year(Date), Month(Date), 1) To DateSerial(Year(Date), Month(Date) + 1, 0) Worksheets.Add.Move after:=Worksheets(Worksheets.Count) ActiveSheet.Name = Format(jour, "dd") Sheets("modele").Cells.Copy Cells.PasteSpecial Sheets("modele").Shapes("Image A DEFINIRE").Copy [A1].PasteSpecial Cells(2, 8) = "Date" Cells(3, 8) = Format(jour, "mm/dd/yyyy") Next jour Application.ScreenUpdating = True ' ActiveWorkbook.Save End Sub

Bonne journée.

Ca marche impec merci Vmax

Kath · 13 Décembre 2018

job75 à dit:

Bonjour Kath, vmax01,

Bon puisqu'on pousse à la consommation voyez le fichier (2) et cette macro :

Code:

Sub CreationMois()
Dim mois$, w As Worksheet, F As Worksheet, vis, n
Do
    mois = InputBox("Numéro du mois et année du mois à créer :", "Création du mois", Format(Date, "m/yy"))
    If mois = "" Then Exit Sub
Loop While Not IsDate("1/" & mois)
mois = "1/" & mois
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'---RAZ---
For Each w In Worksheets
    If w.Name Like "##" Then w.Delete
Next
'---création des feuilles---
Set F = Sheets("modele")
vis = F.Visible
F.Visible = xlSheetVisible 'si la feuille est masquée
Application.Goto F.[A1], True 'cadrage
For n = 1 To Day(DateSerial(Year(mois), Month(mois) + 1, 0))
    F.Copy After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = Format(n, "00")
    Sheets(Sheets.Count).[D2:G2].Clear 'adapter au besoin
    Sheets(Sheets.Count).[H3] = DateSerial(Year(mois), Month(mois), n)
Next
F.Visible = vis 'état initial
Sheets("Accueil").Activate
End Sub

La feuille modele est masquée et j'ai ajouté la feuille Accueil.

J'ai laissé les autres macros mais la création des boutons "MAJ" paraît assez peu utile...

A+

Merci beaucoup pour ce fichier, tu es vraiment un as là dedans.
Bonne journée

XL 2013 Création bouton de copie

Kath

XLDnaute Nouveau

Kath

XLDnaute Nouveau

Kath

XLDnaute Nouveau

Kath

XLDnaute Nouveau

Kath

XLDnaute Nouveau

job75

XLDnaute Barbatruc

vmax01

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Pièces jointes

Kath

XLDnaute Nouveau

Kath

XLDnaute Nouveau

Discussions similaires