Macro pour copier et numéroter les pages d'un carnet

[Océane]

Bonjour le forum
J'ai besoin avec le classeur ci-joint d'une macro qui recopie la feuille 1 autant de fois qu'il est demandé dans la feuille numérotation, et qui numérote les reçus avec le principe décrit dans cette même feuille.
Une fois les feuilles imprimées cela me permettra avec un seul coup de massicot de réaliser 10 carnets de reçus numérotés dans l'ordre : 1 à 225.
Merci d'avance

 

[Staple1600]

Re : Macro pour copier et numéroter les pages d'un carnet

Re

Cette fois c'est bon 🙂


Mais pourquoi y'a -il deux formes superposées ?

Voir copie d'écran dans mon message de 15h07

En fait toutes les formes automatiques sont en doubles sur les feuilles créées.

 

[pierrejean]

Re : Macro pour copier et numéroter les pages d'un carnet

Re

Dans quelle configuration y -a -t -il superposition ?
Pas dans la dernière version j'espere !!!

 

[Staple1600]

Re : Macro pour copier et numéroter les pages d'un carnet

RE


Désolé, 😱 ,dans la dernière version, duplication il y a.


Voir fichier joint

J'ai déplacé manuellement les shapes sur les feuilles créées par la macro

 

[JCGL]

Re : Macro pour copier et numéroter les pages d'un carnet

Bonjour à tous,

PJ : avec ce code cela fonctionne parfaitement sous XL 2003

Sub test()
Application.ScreenUpdating = False
Sheets("Feuil1").Cells.Copy
nb = Range("G9")
For n = 1 To nb
 Sheets.Add.Name = "Feuille" & n
 ActiveSheet.Paste
Next n
For n = 1 To Sheets.Count
 If Left(Sheets(n).Name, 7) = "Feuille" Then
   For m = 1 To Sheets(n).Shapes.Count
      If Left(Sheets(n).Shapes(m).Name, 8) = "Text Box" Then
         Sheets(n).Shapes(m).Select
         form = Selection.Formula
         If InStr(form, "Numérotation!") <> 0 Then
           If InStr(form, "Numérotation!B") <> 0 Then
            col = "B"
           Else
            col = "D"
           End If
             With Selection.Font
              Fsty = .FontStyle
              Fsiz = .Size
               If col = "B" Then Selection.Formula = "Numérotation!B" & CInt(Replace(Sheets(n).Name, "Feuille", "")) + 1
               If col = "D" Then Selection.Formula = "Numérotation!D" & CInt(Replace(Sheets(n).Name, "Feuille", "")) + 1
             .FontStyle = Fsty
             .Size = Fsiz
             End With
         End If
      End If
   Next m
 End If
 ActiveWindow.DisplayGridlines = False
Next n
Application.ScreenUpdating = True
End Sub

A++
A+ à tous

 

[pierrejean]

Re : Macro pour copier et numéroter les pages d'un carnet

Re

OK

Alors teste cette version:

Edit: Merci JCGL
Pas de double shape ??

 

[JCGL]

Re : Macro pour copier et numéroter les pages d'un carnet

Re,

Je vois que nous avons eu la même idée : suppression de l'appel à la Sub Recopie()

A++
A+ à tous

 

[pierrejean]

Re : Macro pour copier et numéroter les pages d'un carnet

Re

En y regardant de plus près je vois que mon ami JCGL a lui aussi viré

Recopie (Sheets(n).Name)

Xl2003 sachant recopier les shapes Avec

Sheets("Feuil1").Cells.Copy
......
ActiveSheet.Paste

Je vais pouvoir dormir un peu plus tranquille ce soir

 

[JCGL]

Re : Macro pour copier et numéroter les pages d'un carnet

Re,

PJ : Peux-tu éditer ton profil et renseigner ta version XL ?

Merci et A++
A+ à tous

 

[Staple1600]

Re : Macro pour copier et numéroter les pages d'un carnet

Re


pierrejean:

(et JCGL) tu pourras dormir et même faire de doux rêves
car ca y est c'est ok sur mon pc

avec ton fichier 17h34