Bouton + Macro : Triple numéro / date / impression

Le 24/10/2013 à 17:35

Bonjour à tous,

J'ai besoin d'un petit coup de main, et comme le sujet de ce post ne permet pas de tout dire, je vous explique mon cas :

Sur le fichier joint exemple.xls, se trouve 6 feuilles, nommées respectivement Muscu 2013, Suivi de séances, ProtA, ProtB, Feuil1 et Feuil1(2); Feuil1(2) étant une simple copie de Feuil1.

Muscu 2013 référence des personnes avec certaines données qui sont ensuite retrouvés dans ProtA ou ProtB, des lors que l'on inscrit le nom de cette personne dans une des deux feuilles.

Sur chacune de ces feuilles se trouve trois boutons, qui me permettent une fois ma feuille complétée, de retranscrire directement sur ma feuille Suivi de séance les données qui me sont nécessaires, et ensuite m'imprime ma feuille ProtA ou ProtB.

Jusque là, tout fonctionne. Mais voici le début du problème :

J'ai créé la feuille Feuil1, qui va me servir pour imprimer des étiquettes pour un complément à ajouter en plus.

Grace à la fonction SI, j'ai trouvé un petit système qui me permet de retranscrire directement les données écrites sur ProtA ou ProtB, en fonction de celle qui a le numéro de préparation le plus élevé.

De ce fait, le numéro de préparation du complément doit suivre celui retranscrit en ProtA ou B.

Ex : Pour Mr X. Prot A = N°10, Complément = N°11.

Pour les week-ends, je produit le Vendredi pour Vendredi, Samedi, Dimanche, d'où le bouton Triple.

A partir de la macro "impression transfert en Triple" de la feuille ProtA, j'ai bidouillé la macro pour essayer de :

  • Retranscrire en triple les infos de Feuil1 sur la feuille Suivi de séance, avec un intervalle de 2 entre chaque numéro de préparation
  • Avoir les trois numéro de préparation dans la case N° de préparation
  • Avoir l'impression de 3 étiquettes, une avec le jour de fabrication, une avec le jour de fabrication + 1, et jour de fabrication + 2.

J'en suis donc arrivé à cette macro :

Sheets("Suivi des séances").Select

Rows("7:7").Select

Selection.Insert Shift:=xlDown

Selection.Insert Shift:=xlDown

Selection.Insert Shift:=xlDown

Sheets("Feuil1").Select

Range("B6").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Suivi des séances").Select

Range("B7:B9").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Sheets("Feuil1").Select

Range("F7").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Suivi des séances").Select

Range("C7 ").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Range("D7").Select

ActiveCell.FormulaR1C1 = "=RC[-1]+2"

Range("D7").Select

Selection.Copy

Range("C8").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Range("D7").Select

Selection.ClearContents

Range("D8").Select

ActiveCell.FormulaR1C1 = "=R[-1]C[-1]+4"

Range("D8").Select

Selection.Copy

Range("C9").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Range("D8").Select

Selection.ClearContents

Range("G7").Select

Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = "Binaire"

With ActiveCell.Characters(Start:=1, Length:=18).Font

.Name = "Arial"

.FontStyle = "Gras"

.Size = 14

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ColorIndex = xlAutomatic

Dim i As Integer

'Indiquer le nombre de Feuille à Imprimer

Range("G1").FormulaR1C1 = InputBox("Indiquer le nombre de Feuille à Imprimer ")

If Range("G1").Value <= 0 Then

If Range("G1") = "" Then

MsgBox "Merci de renseigner le nombre de Feuille "

End If

End If

For i = 1 To Range("G1").Value

ActiveWindow.SelectedSheets.PrintOut

Range("D4").Value = Range("D4").Value + 1

Next i

End With

Range("G7").Select

Selection.Copy

Range("G8:G9").Select

ActiveSheet.Paste

Range("B6:G56").Select

Selection.Sort Key1:=Range("G6"), Order1:=xlAscending, Key2:=Range("B6") _

, Order2:=xlAscending, Key3:=Range("C6"), Order3:=xlAscending, Header:= _

xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _

xlSortNormal

Range("G8").Select

Sheets("Feuil1").Select

Range("C7").Select

ActiveCell.FormulaR1C1 = "=R[-5]C[-1] &"" / "" & R[-5]C[-1]+2 &"" / "" & R[-5]C[-1]+4"

Range("C7").Select

Selection.Copy

Range("G6").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Range("C7").Select

Selection.ClearContents

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

End Sub

Hélas, a mon grand désespoir, cela ne fonctionne pas comme je l'imaginais.

La partie transcription sur la feuille Suivi de séance marche parfaitement.

Mais, au final, mon numéro de préparation, (en F7), n'est pas inscrit en triple, mais apparaît sous forme /2/4 à chaque fois.

De plus ma feuille Feuil1 se trouve au final complétement déformé, puisque l'infirmation "Binaire", qui doit apparaitre sur la feuille Suivi de séance, apparait aussi sur la feuille Feuil1, et désorganise tout.

Et finalement, j'ai trouvé sur un forum cette macro, qui me permet d'imprimer trois feuilles avec trois dates différentes :

Dim i As Integer

'Indiquer le nombre de Feuille à Imprimer

Range("G1").FormulaR1C1 = InputBox("Indiquer le nombre de Feuille à Imprimer ")

If Range("G1").Value <= 0 Then

If Range("G1") = "" Then

MsgBox "Merci de renseigner le nombre de Feuille "

End If

End If

For i = 1 To Range("G1").Value

Je l'ai intégrée, mais premièrement je ne sais pas si je l'ai intégrée au bon endroit, et deuxièmement elle ne me satisfait pas vraiment.

Je demande donc votre aide pour :

A. Savoir si quelqu'un peut m'indiquer ce qui cloche dans la macro que j'ai bidouillée.

B. Savoir si quelqu'un aurait une macro plus adaptée que la dernière.

Voila, j’espère avoir été assez clair. Si vous voulez comprendre un peu mieux comment cela je vous invite à tester le fichier directement, mais penser à débrancher votre imprimante, si vous ne voulez vous faire manger beaucoup de papier.

Je vous remercie d’avoir pris le temps de lire tout ça. J'espère que c'est compréhensible.

En attendant d'avoir un réponse, je vous souhaite une bonne journée.

44exemple.zip (107.48 Ko)

Signé PerPer

Le 24/10/2013 à 18:40

Bonjour

Ne sachant pas exactement le résultat que tu voulais, je me suis basé sur une macro et j'ai essayé de simplifier et d'obtenir le même résultat que celui avec ta macro

Alors pour débuter essayes cette macro

Sub Impression_transfert_ProtA_en_triple()
Dim Nblg As Long

  With Sheets("Suivi des séances")
    Nblg = .Range("B" & Rows.Count).End(xlUp).Row + 1
    Range("B1").Copy .Range("B" & Nblg & ":B" & Nblg + 2)
    Range("B2").Copy .Range("C" & Nblg)
    .Range("C" & Nblg).AutoFill .Range("C" & Nblg & ":C" & Nblg + 2), xlFillSeries
    With .Range("G" & Nblg & ":G" & Nblg + 2)
      .Value = "Binaire"
      .Font.Name = "Arial"
      .Font.FontStyle = "Gras"
      .Font.Size = 14
    End With
    .Range("B6:G56").Sort Key1:=.Range("G6"), Order1:=xlAscending, Key2:=.Range("B6"), _
          Order2:=xlAscending, Key3:=.Range("C6"), Order3:=xlAscending, Header:=xlNo, _
          OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
          DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
  End With
  With Sheets("Feuil1")
    With .Range("B2")
      .Formula = "=F6 & "" / "" & F6+1 & "" / "" & F6+2"
      .Value = .Value
    End With
    .PrintPreview
  End With
End Sub
Le 28/10/2013 à 11:18

Bonjour à Tous.

Merci Banzai pour ta réponse, je m'en suis servit pour mes macros et ça marche. Merci beaucoup.

Maintenant, je souhaite imprimer ma Feuil1 en trois exemplaires :

Le premier avec la date inscrit en "F6"

Le second avec la date + 1 jour en "F6"

Et le troisième avec la date + 2 jours en "F6"

Je n'arrive pas à trouver un moyen y parvenir, quelqu'un aurait une solution?

Le 28/10/2013 à 11:36

Bonjour

Sans fichier

Un bouton liée à cette macro

La date est déjà présente en F6

Sub Impression()
  With Sheet("Feuil1")
    .PrintOut
    .Range("F6") = .Range("F6") + 1
    .PrintOut
    .Range("F6") = .Range("F6") + 1
    .PrintOut
  End With
End Sub
Le 28/10/2013 à 12:12

Merci beaucoup Banzai.

C'est exactement ce qu'il me fallait.

Merci à la communauté du forum.

Est ce que cela intéresse quelqu'un que je poste les macros que j'ai utilisé, en expliquant leur fonctionnement?

Rechercher des sujets similaires à "bouton macro triple numero date impression"