Discussion :

[gabi75]

Bonjour à tous,

Pour faire suite au topic que j'ai ouvert précedemment concernant une copie de cellule, J'ai cette fois-ci besoin de copier une selection de cellule contenant 2 tableaux qui se mettent à jour mensuellement.
C'est à dire que chaque mois environ 4 ou5 lignes s'ajouttent dans les 2 tableaux et la selection doit les prendre en compte évidemment.
le but de cette copie est de la placer par la suite dans un fichier ppt.
Voic le code que j'utilise:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Dim PptApp As PowerPoint.Application
Dim PptDoc As PowerPoint.Presentation
Dim Diapo As PowerPoint.Slide
Dim Sh As PowerPoint.Shape
Dim Cs1 As ColorScheme
'Dim NbShpe As Integer
 
 
Set PptApp = CreateObject("Powerpoint.Application")
Set PptDoc = PptApp.Presentations.Add
PptApp.Visible = True
Set PptDoc = PptApp.Presentations.Open("G:\Creditbail\Immtech\Documentation Support\Stat Itrack\TemplateStats.pptx")
 
 With PptDoc
 
   '--- Ajoute un nouveau slide et le positionner en 2eme position
    Set Diapo = .Slides.Add(Index:=2, Layout:=ppLayoutBlank)
 
'--    'Crée une zone de texte (AddLabel)
    Set Sh = .Slides(2).Shapes.AddLabel(Orientation:=msoTextOrientationHorizontal, _
       Left:=50, Top:=50, Width:=500, Height:=50)
       'insère la valeur de la Cellule A30 dans une zone de texte
    Sheets("Synthèse").Select
    Sh.TextFrame.TextRange.Text = Range("A30")
    'Modifie la couleur du texte
    Sh.TextFrame.TextRange.Font.Color = RGB(250, 0, 0)
    Workbooks.Open Filename:="G:\Creditbail\Immtech\Documentation Support\Stat Itrack\Suivi global\eXport.xls"
    Sheets("tcd_flux").Select
    Range("A1:K37").Select
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    'Effectue un collage dans la 2eme diapositive
    .Slides(2).Shapes.Paste
 
    With .Slides(2).Shapes(.Slides(2).Shapes.Count)
        .Name = "monTableau" 'Renomme l'objet collé
        .Left = 150 'position horizontale dans le slide
        .Top = 100 'position verticale dans le slide
        .Height = 300 'hauteur
        .Width = 400 'largeur
    End With

avec ce code j'arrive à copier l'intégralité de la selection, et de la coller dans le slide souhaité.
Voici le lien de la discussion souhaitée pour retrouver la pièce jointe utilisée.

http://www.developpez.net/forums/d92...teres-definir/

Pour récapituler:
par rapport à la selection, comment dois-je faire pour prendre toutes les cellules non nulles des colonnes A à K.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Range("A1:K37").Select
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

[gabi75]

je voudrais aussi changer la police des titres en gras et l'aligner à gauche.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
--    'Crée une zone de texte (AddLabel)
    Set Sh = .Slides(2).Shapes.AddLabel(Orientation:=msoTextOrientationHorizontal, _
       Left:=50, Top:=50, Width:=500, Height:=50)
       'insère la valeur de la Cellule A30 dans une zone de texte
    Sheets("Synthèse").Select
    Sh.TextFrame.TextRange.Text = Range("A30")
    'Modifie la couleur du texte
    Sh.TextFrame.TextRange.Font.Color = RGB(250, 0, 0)

Edit:

Il suffit de rajouter les lignes de codes suivantes:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Sh.TextFrame.TextRange.Font.Bold = msoCTrue
    Sh.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignLeft