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 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119
| Option Explicit
' Objet application qui reçoit les événements
Private WithEvents oApp As PowerPoint.Application
'---------------------------------------------------------------------------
' Initialisation de la classe
'---------------------------------------------------------------------------
Private Sub Class_Initialize()
Set oApp = New PowerPoint.Application
End Sub
'---------------------------------------------------------------------------
' Libération de la classe
'---------------------------------------------------------------------------
Private Sub Class_Terminate()
Set oApp = Nothing
End Sub
Private Sub oApp_SlideShowNextSlide(ByVal Wn As SlideShowWindow)
'---------------------------------------------------------------------------------------
' Procedure : ImportExcel
' Auteur : Vins86
' Date : 23/07/2014
' 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 A, B, C, D
'ouverture du fichier Excel
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open("F:\Vincent\bandeau\BandeauNR.xls")
Set xlSheet = xlBook.sheets("Global")
'---------------------------------------------------------------------------------------
'boucle
For A = 1 To 3 'ligne
For B = 6 To 8 ' ligne
For C = 11 To 13 ' ligne
For D = 16 To 18 ' ligne
'---------------------------------------------------------------------------------------
' on crée une zone de titre1
Set shpTexte = ActivePresentation.Slides(A).Shapes("titre1")
With shpTexte.TextFrame.TextRange
.Font.Size = 12
.Text = xlSheet.Cells(A, 1).Value
End With
' on crée une zone de texte1
Set shpTexte = ActivePresentation.Slides(A).Shapes("test1")
With shpTexte.TextFrame.TextRange
.Font.Size = 14
.Text = xlSheet.Cells(A, 5).Value
End With
'---------------------------------------------------------------------------------------
' on crée une zone de titre1
Set shpTexte = ActivePresentation.Slides(B).Shapes("titre1")
With shpTexte.TextFrame.TextRange
.Font.Size = 12
.Text = xlSheet.Cells(B, 1).Value
End With
' on crée une zone de texte1
Set shpTexte = ActivePresentation.Slides(B).Shapes("test1")
With shpTexte.TextFrame.TextRange
.Font.Size = 14
.Text = xlSheet.Cells(B, 5).Value
End With
'---------------------------------------------------------------------------------------
' on crée une zone de titre1
Set shpTexte = ActivePresentation.Slides(C).Shapes("titre1")
With shpTexte.TextFrame.TextRange
.Font.Size = 12
.Text = xlSheet.Cells(C, 1).Value
End With
' on crée une zone de texte1
Set shpTexte = ActivePresentation.Slides(C).Shapes("test1")
With shpTexte.TextFrame.TextRange
.Font.Size = 14
.Text = xlSheet.Cells(C, 5).Value
End With
'---------------------------------------------------------------------------------------
' on crée une zone de titre1
Set shpTexte = ActivePresentation.Slides(D).Shapes("titre1")
With shpTexte.TextFrame.TextRange
.Font.Size = 12
.Text = xlSheet.Cells(D, 1).Value
End With
' on crée une zone de texte1
Set shpTexte = ActivePresentation.Slides(D).Shapes("test1")
With shpTexte.TextFrame.TextRange
.Font.Size = 14
.Text = xlSheet.Cells(D, 5).Value
End With
Next D
Next C
Next B
Next A
' Fermeture
xlApp.Quit
End Sub |
Partager