Discussion :

[mimilll]

Bonjour le forum,

VBA sur excel, je m'éclate mais pour PowerPoint... c'est la traversee du desert!!

He bien... tout semble etre dans le titre...

Je n'arrive pas à copier le contenus de plusieurs cellules Excel par exemple:

Code :

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

1
2
3
4
5
Do Until Sheets("input").Range("H" & Row).Value = ""
  strRegion = Sheets("input").Range("H" & Row).Value
  ???
  Row = Row + 1
Loop

dans une seule liste texte dans ppt (une liste de points les uns en dessous des autres).

J'ai bien trouvé ca, mais ca ne m'aide pas des masses:
http://www.developpez.net/forums/d72...l-coller-form/

Je vous remercie,
Emil

[Invité]

Bonjour

Dans le code que tu as vu, il s'agit de l'import d'une cellule dans une zone de texte.

Ce que tu veux c'est récupérer plusieurs données en provenance d'Excel des cellules H12 à H20, mais ces données réparties dans différentes cellules, tu veux les cumuler dans une seule zone de texte ou plusieurs ?

C'est là que j'ai un peu de mal à comprendre.

Edit : j'ai compris

Philippe

[mimilll]

Bonjour,

merci de vous saisir de ma question

dans une seule liste

une zone de texte avec des petites fleches pour chaque retour à la ligne.

Merci,
Emilien

[Invité]

Re

Voici le code que tu as précedement ajusté à ton case

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
Public Sub ImportExcel()
     '---------------------------------------------------------------------------------------
     ' Procedure      : ImportExcel
     ' Auteur         : Philippe JOCHMANS - http://starec.developpez.com
     ' Date           : 12/04/2009
     ' Commentaires   :
     '---------------------------------------------------------------------------------------
 
    'déclaration des variables
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim shpTexte As Shape
    Dim i As Integer
    Dim strChaine As String
 
    'ouverture du fichier Excel
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Open("C:\Users\Philippe\Desktop\test.xls")
    Set xlSheet = xlBook.Sheets("Feuil1")
 
    ' on crée une zone de texte
    Set shpTexte = ActivePresentation.Slides(1).Shapes.AddTextbox(msoTextOrientationHorizontal, 50, 50, 200, 50)
    ' on va stocker les valeurs dans une chaine en insérant un retoure chariot pour créer des paragraphes
    For i = 12 To 20
        strChaine = strChaine & xlSheet.Range("H" & i).Value & vbCrLf
    Next i
    ' on ajoute l'ensemble à la zone de texte
    shpTexte.TextFrame.TextRange.Text = strChaine
    ' Fermeture
    xlApp.Quit
 
End Sub

Bien sûr il faut changer le chemin du classeur et le nom de la feuille.

On fait juste une boucle pour remplir une chaine avec des retours chariots que l'on affecte ensuite à la zone de texte.

Philippe

[mimilll]

Re,

J'essaie d'adapter ton code a mon cas:

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
Dim pptApp As PowerPoint.Application
Dim pptPre As PowerPoint.Presentation
Dim strRegion As String
Dim intRowRegion As Integer
Dim shpText As Shape
Dim strChaine As String
 
Parametre                   'je recupere differente valeurs pour mes variables
Set pptApp = CreateObject("Powerpoint.Application")
pptApp.Visible = True
Set pptPre = pptApp.Presentations.Open(ThisWorkbook.Path & "\test.ppt")
 
 
'ecrire la liste des regions en slide d'intro:
Set shpText = ActivePresentation.Slides(1).Shapes.AddTextbox(msoTextOrientationHorizontal, 50, 50, 200, 50)
intRowRegion = 12
Do Until Sheets("input").Range("H" & intRowRegion).Value = ""
  strRegion = Sheets("input").Range("H" & intRowRegion).Value
  strChaine = strChaine & Sheets("input").Range("H" & intRowRegion).Value & vbCrLf
  intRowRegion = intRowRegion + 1
Loop
shpText.TextFrame.TextRange.Text = strChaine

A noter: je lance la macro depuis Excel.

La ligne en rouge renvoie l'erreur 429: composant Active-X (je suis en Allemagne, c'est donc un peut dur a traduire, sorry).

Je pense que je m'egare entre xls et ppt: j'ai tenté de remplacer "ActivePresentation":

Code :

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

Set shpText = ActivePresentation.Slides(1).Shapes.AddTextbox(msoTextOrientationHorizontal, 50, 50, 200, 50)

par "pptPre" => mais erreur 13
et par "pptApp.Presentations." => mauvaise methode (slides(1) est alors surligné)

[Invité]

Re

Essayes de déclarer

Code :

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

Dim shpText As PowerPoint.Shape

Philippe

[mimilll]

toujours erreur 429 sur la meme ligne

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
Sub Create_ppt_region()
 
Dim pptApp As PowerPoint.Application
Dim pptPre As PowerPoint.Presentation
Dim strRegion As String
Dim pptSlideNumber As Integer
Dim intRowRegion As Integer
Dim shpText As PowerPoint.Shape
Dim strChaine As String
 
Parametre
Set pptApp = CreateObject("Powerpoint.Application")
pptApp.Visible = True
Set pptPre = pptApp.Presentations.Open(ThisWorkbook.Path & "\test.ppt")
 
 
'ecrire la liste des regions en slide d'intro:
Set shpText = ActivePresentation.Slides(1).Shapes.AddTextbox(msoTextOrientationHorizontal, 50, 50, 200, 50)
intRowRegion = 12
Do Until Sheets("input").Range("H" & intRowRegion).Value = ""
  strRegion = Sheets("input").Range("H" & intRowRegion).Value
  strChaine = strChaine & Sheets("input").Range("H" & intRowRegion).Value & vbCrLf
  intRowRegion = intRowRegion + 1
Loop
shpText.TextFrame.TextRange.Text = strChaine

[Invité]

Re

Je viens de tester intégralement ton code dans Excel (j'ai fait un copier coller), cela fonctionne chez moi si tu mets cela :

Code :

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

Set shpText = pptPre.Slides(1).Shapes.AddTextbox(msoTextOrientationHorizontal, 50, 50, 200, 50)

J'ai bien l'ouverture du ppt et l'écriture des données que j'ai saisi en H12 à H20.

Philippe

[mimilll]

Ca marche, je te remercie !!

mais si je galere comme ca, alors que j'en suis qu'au début,, je vais devoir revoir mes prétentions à la baisse...

Merci encore et bonne soirée!
Emilien