Boucle de sélection avec impression powerpoint

Word, PowerPoint, Outlook, Access et tous les autres logiciels de la suite Office (sauf Excel)
e
eric68
Jeune membre
Jeune membre
Messages : 12
Inscrit le : 20 février 2018
Version d'Excel : 2007

Message par eric68 » 23 février 2018, 08:01

Bonjour à tous,
J'ais vraiment du mal à réaliser ce que je souhaites.
J'aimerais pouvoir ouvrir une (feuille x) copier les valeur de deux cellules (C3;C4) et les copier dans une autre feuille en (B3;B4) puis (ouverture d'un fichier pptx en liaison avec excel) et imprimer celui-ci. Pour l'impression c'est OK
puis à nouveau copier les valeurs suivant de la même colonne de la feuilles x (C5;C6 )et les coller au même endroit dans l'autre feuille et imprimer.
idem jusqu'à ce que la colonne de la (feuille x) ne comporte plus de valeur.
merci encore pour votre aide.....
Voici ce que j'ais réaliser mais cela ne fonctionne pas
    sheets("SUIVI AFFICHE").Select
    Range("C3:C4").Select
    Selection.Copy
    Sheets("CODE PRODUIT").Select
    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
'Sheets("SUIVI AFFICHE").Range("C3").Copy Destination:=Sheets("CODE PRODUIT").Range("B3")
    Set PptApp = CreateObject("Powerpoint.Application")
PptApp.Activate
Set PptDoc = PptApp.Presentations.Open("D:\Affiches A5 fin de stock.pptx", msoTrue)
PptDoc.PrintOptions.ActivePrinter = Range("Accueil!B4").Value
PptDoc.PrintOut From:=1, To:=1, Copies:=1
PptApp.ActivePresentation.PrintOut
PptDoc.Close
PptApp.Quit
 ActiveCell.Offset(1, 0).Select
 Do While ActiveCell.Value <> ""
 ActiveCell.Offset(1, 0).Select
 Loop
 End Sub
Merci encore.
Modifié en dernier par eric68 le 27 février 2018, 15:21, modifié 1 fois.
h
h2so4
Passionné d'Excel
Passionné d'Excel
Messages : 8'676
Appréciations reçues : 310
Inscrit le : 16 juin 2013
Version d'Excel : 365 UK Windows 10

Message par h2so4 » 23 février 2018, 09:43

Bonjour,

peux-tu changer ton titre ?

voici une proposition (non testée)
Set ws1 = Sheets("SUIVI AFFICHE")
    Set ws2 = Sheets("CODE PRODUIT")
    i = 3
    Do While ws1.Range("C" & i) <> ""
        ws1.Range("C" & i).Resize(, 2).Copy ws2.Range("B3")
        Set PptApp = CreateObject("Powerpoint.Application")
        PptApp.Activate
        Set PptDoc = PptApp.Presentations.Open("D:\Affiches A5 fin de stock.pptx", msoTrue)
        PptDoc.PrintOptions.ActivePrinter = Range("Accueil!B4").Value
        PptDoc.PrintOut From:=1, To:=1, Copies:=1
        PptApp.ActivePresentation.PrintOut
        PptDoc.Close
        PptApp.Quit
        i = i + 2
    Loop
1 membre du forum aime ce message.
e
eric68
Jeune membre
Jeune membre
Messages : 12
Inscrit le : 20 février 2018
Version d'Excel : 2007

Message par eric68 » 23 février 2018, 19:44

Merci beaucoup pour ton aide, je suis nouveau sur le forum, donc je ne connais pas bien encore les règles de ce forum, mais je fais de mon mieux.je regard demain au travail si ta macro fonctionne bien, merci d'avance c'est vraiment sympa.
e
eric68
Jeune membre
Jeune membre
Messages : 12
Inscrit le : 20 février 2018
Version d'Excel : 2007

Message par eric68 » 27 février 2018, 15:02

Bonjour,

Malheureusement cela ne fonctionne pas, il me copie la recherche v de la cellule ("C3") et non la valeur
Pouvez vous encore me donner un p'tit coup de main?
Merci encore d'avance.
h
h2so4
Passionné d'Excel
Passionné d'Excel
Messages : 8'676
Appréciations reçues : 310
Inscrit le : 16 juin 2013
Version d'Excel : 365 UK Windows 10

Message par h2so4 » 27 février 2018, 15:16

bonjour,

merci de changer ton titre.
Set ws1 = Sheets("SUIVI AFFICHE")
    Set ws2 = Sheets("CODE PRODUIT")
    i = 3
    Do While ws1.Range("C" & i) <> ""
        ws2.Range("B3").value=ws1.Range("C" & i).value
        ws2.Range("B4").value=ws1.range("C" & i+1).value
        Set PptApp = CreateObject("Powerpoint.Application")
        PptApp.Activate
        Set PptDoc = PptApp.Presentations.Open("D:\Affiches A5 fin de stock.pptx", msoTrue)
        PptDoc.PrintOptions.ActivePrinter = Range("Accueil!B4").Value
        PptDoc.PrintOut From:=1, To:=1, Copies:=1
        PptApp.ActivePresentation.PrintOut
        PptDoc.Close
        PptApp.Quit
        i = i + 2
    Loop
e
eric68
Jeune membre
Jeune membre
Messages : 12
Inscrit le : 20 février 2018
Version d'Excel : 2007

Message par eric68 » 27 février 2018, 15:44

Merci pour la partie de la boucle cela fonctionne.
Pouvez vous encore m'aider pour réaliser une macro
Une mises à jour des liaison PowerPoint à l'ouverture, sans avoir le message voulez mettre à jour les liaisons.

Je vous en demande beaucoup...Mais je suis vraiment nul, mais j'essaye de comprendre comment cela fonctionne.
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message