XL 2013 Création bouton de copie

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 🙂

Cliquez pour agrandir...

vmax01 à dit:

desolé Job75 et bonjour nos messages se sont croisés....

Cliquez pour agrandir...

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+

Cliquez pour agrandir...

Cliquez pour agrandir...

job75 à dit:

Bonjour Kath, bienvenue sur XLD,

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

A+

Cliquez pour agrandir...

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.

Cliquez pour agrandir...

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+

Cliquez pour agrandir...