vikasbhandari2
Jun 19th, 2006, 05:07 AM
Thanks for the Reply! Here is the code.
Dim oshape As PowerPoint.Shape ' Stores Powerpoint objects
Dim ofile As PowerPoint.Presentation 'Powerpoint Presentation object
Dim pptApp As PowerPoint.Application 'Powerpoint application object
Dim oGraph As Graph.Chart
Dim rnge As Long
Dim fir(27) As Integer
Dim i As Integer
Dim objs(6, 27) As Integer
Dim slds(6, 9) As Integer
Dim cols(6, 3) As String 'we need to make \it two dimensiol for future reference
Dim j As Integer
Dim k As Integer
Dim xlwrk As Excel.Workbook
Dim ppt As Object
Dim ppt1 As String
Dim mon(12) As String
Dim newRan As Range
mon(1) = "A"
mon(2) = "B"
mon(3) = "C"
mon(4) = "D"
mon(5) = "E"
mon(6) = "F"
mon(7) = "G"
mon(8) = "H"
mon(9) = "I"
mon(10) = "J"
mon(11) = "K"
mon(12) = "L"
slds(1, 1) = 16
slds(1, 2) = 17
slds(1, 3) = 18
slds(1, 4) = 21
slds(1, 5) = 22
slds(1, 6) = 23
slds(1, 7) = 24
slds(1, 8) = 25
slds(1, 9) = 26
slds(2, 1) = 27
slds(2, 2) = 28
slds(2, 3) = 29
slds(2, 4) = 32
slds(2, 5) = 33
slds(2, 6) = 34
slds(2, 7) = 35
slds(2, 8) = 36
slds(2, 9) = 37
slds(3, 1) = 38
slds(3, 2) = 39
slds(3, 3) = 40
slds(3, 4) = 43
slds(3, 5) = 44
slds(3, 6) = 45
slds(3, 7) = 46
slds(3, 8) = 47
slds(3, 9) = 48
slds(4, 1) = 49
slds(4, 2) = 50
slds(4, 3) = 51
slds(4, 4) = 54
slds(4, 5) = 55
slds(4, 6) = 56
slds(4, 7) = 57
slds(4, 8) = 58
slds(4, 9) = 59
slds(5, 1) = 60
slds(5, 2) = 61
slds(5, 3) = 62
slds(5, 4) = 65
slds(5, 5) = 66
slds(5, 6) = 67
slds(5, 7) = 68
slds(5, 8) = 69
slds(5, 9) = 70
slds(6, 1) = 71
slds(6, 2) = 72
slds(6, 3) = 73
slds(6, 4) = 76
slds(6, 5) = 77
slds(6, 6) = 78
slds(6, 7) = 79
slds(6, 8) = 80
slds(6, 9) = 81
objs(1, 1) = 12
objs(1, 2) = 13
objs(1, 3) = 10
objs(1, 4) = 11
objs(1, 5) = 3
objs(1, 6) = 7
objs(1, 7) = 7
objs(1, 8) = 11
objs(1, 9) = 3
objs(1, 10) = 6
objs(1, 11) = 10
objs(1, 12) = 0
objs(1, 13) = 14
objs(1, 14) = 8
objs(1, 15) = 12
objs(1, 16) = 13
objs(1, 17) = 7
objs(1, 18) = 12
objs(1, 19) = 16
objs(1, 20) = 7
objs(1, 21) = 3
objs(1, 22) = 6
objs(1, 23) = 8
objs(1, 24) = 16
objs(1, 25) = 14
objs(1, 26) = 10
objs(1, 27) = 0
objs(2, 1) = 19
objs(2, 2) = 3
objs(2, 3) = 11
objs(2, 4) = 11
objs(2, 5) = 3
objs(2, 6) = 7
objs(2, 7) = 7
objs(2, 8) = 12
objs(2, 9) = 3
objs(2, 10) = 10
objs(2, 11) = 6
objs(2, 12) = 0
objs(2, 13) = 3
objs(2, 14) = 9
objs(2, 15) = 13
objs(2, 16) = 4
objs(2, 17) = 5
objs(2, 18) = 13
objs(2, 19) = 4
objs(2, 20) = 7
objs(2, 21) = 14
objs(2, 22) = 3
objs(2, 23) = 7
objs(2, 24) = 13
objs(2, 25) = 13
objs(2, 26) = 9
objs(2, 27) = 0
objs(3, 1) = 19
objs(3, 2) = 3
objs(3, 3) = 11
objs(3, 4) = 11
objs(3, 5) = 3
objs(3, 6) = 7
objs(3, 7) = 7
objs(3, 8) = 12
objs(3, 9) = 3
objs(3, 10) = 10
objs(3, 11) = 6
objs(3, 12) = 0
objs(3, 13) = 3
objs(3, 14) = 9
objs(3, 15) = 13
objs(3, 16) = 4
objs(3, 17) = 5
objs(3, 18) = 13
objs(3, 19) = 4
objs(3, 20) = 7
objs(3, 21) = 14
objs(3, 22) = 3
objs(3, 23) = 7
objs(3, 24) = 13
objs(3, 25) = 14
objs(3, 26) = 10
objs(3, 27) = 0
objs(4, 1) = 19
objs(4, 2) = 3
objs(4, 3) = 11
objs(4, 4) = 14
objs(4, 5) = 4
objs(4, 6) = 9
objs(4, 7) = 7
objs(4, 8) = 12
objs(4, 9) = 3
objs(4, 10) = 10
objs(4, 11) = 6
objs(4, 12) = 0
objs(4, 13) = 3
objs(4, 14) = 9
objs(4, 15) = 13
objs(4, 16) = 4
objs(4, 17) = 5
objs(4, 18) = 13
objs(4, 19) = 4
objs(4, 20) = 7
objs(4, 21) = 14
objs(4, 22) = 3
objs(4, 23) = 7
objs(4, 24) = 13
objs(4, 25) = 14
objs(4, 26) = 10
objs(4, 27) = 0
objs(5, 1) = 18
objs(5, 2) = 19
objs(5, 3) = 10
objs(5, 4) = 14
objs(5, 5) = 4
objs(5, 6) = 9
objs(5, 7) = 7
objs(5, 8) = 12
objs(5, 9) = 3
objs(5, 10) = 10
objs(5, 11) = 6
objs(5, 12) = 0
objs(5, 13) = 3
objs(5, 14) = 9
objs(5, 15) = 13
objs(5, 16) = 4
objs(5, 17) = 5
objs(5, 18) = 13
objs(5, 19) = 4
objs(5, 20) = 7
objs(5, 21) = 14
objs(5, 22) = 3
objs(5, 23) = 7
objs(5, 24) = 13
objs(5, 25) = 14
objs(5, 26) = 10
objs(5, 27) = 0
objs(6, 1) = 18
objs(6, 2) = 19
objs(6, 3) = 10
objs(6, 4) = 14
objs(6, 5) = 4
objs(6, 6) = 9
objs(6, 7) = 7
objs(6, 8) = 12
objs(6, 9) = 3
objs(6, 10) = 10
objs(6, 11) = 6
objs(6, 12) = 0
objs(6, 13) = 3
objs(6, 14) = 9
objs(6, 15) = 13
objs(6, 16) = 4
objs(6, 17) = 5
objs(6, 18) = 13
objs(6, 19) = 4
objs(6, 20) = 7
objs(6, 21) = 14
objs(6, 22) = 3
objs(6, 23) = 7
objs(6, 24) = 13
objs(6, 25) = 14
objs(6, 26) = 10
objs(6, 27) = 0
cols(1, 1) = "B"
cols(1, 2) = "D"
cols(1, 3) = "F"
cols(2, 1) = "I"
cols(2, 2) = "K"
cols(2, 3) = "M"
cols(3, 1) = "P"
cols(3, 2) = "R"
cols(3, 3) = "T"
cols(4, 1) = "W"
cols(4, 2) = "Y"
cols(4, 3) = "AA"
cols(5, 1) = "AD"
cols(5, 2) = "AF"
cols(5, 3) = "AH"
cols(6, 1) = "AK"
cols(6, 2) = "AM"
cols(6, 3) = "AO"
fir(1) = 2
fir(2) = 2
fir(3) = 3
fir(4) = 1
fir(5) = 1
fir(6) = 1
fir(7) = 1
fir(8) = 3
fir(9) = 1
fir(10) = 4
fir(11) = 4
fir(12) = 0
fir(13) = 1
fir(14) = 1
fir(15) = 1
fir(16) = 1
fir(17) = 1
fir(18) = 1
fir(19) = 3
fir(20) = 3
fir(21) = 3
fir(22) = 1
fir(23) = 1
fir(24) = 1
fir(25) = 2
fir(26) = 2
fir(27) = 0
Dim rowArr(9) As Integer
rowArr(1) = 3
rowArr(2) = 8
rowArr(3) = 12
rowArr(4) = 17
rowArr(5) = 24
rowArr(6) = 27
rowArr(7) = 30
rowArr(8) = 34
rowArr(9) = 37
Dim objCoun As Integer ' this is a counter for increasing Object's Value
Dim coun As Integer
Dim mo As Integer
objCoun = 1
mo = InputBox("Enter The Month for which you want to update the presentation")
If mo = Sheet3.Range("A1").Value Then
Set xlwrk = ActiveWorkbook
Set pptApp = CreateObject("PowerPoint.Application")
pptApp.Visible = msoTrue
Set ofile = pptApp.Presentations.Open(ThisWorkbook.Path & "\2006 Citigroup KPI1.ppt")
Dim grp As Integer
Sheets("Sheet2").Select
For grp = 1 To 1
'MsgBox ("Startng " & grp)
objCoun = 1
coun = 1
For i = 1 To 9
Dim bool As Boolean
For j = 1 To 3
coun = rowArr(i)
If fir(objCoun) > 0 Then
bool = True
k = 1
For k = 1 To fir(objCoun)
ofile.Slides(slds(grp, i)).Select
Set oshape = ofile.Slides(slds(grp, i)).Shapes("object " & objs(grp, objCoun))
Set oGraph = oshape.OLEFormat.Object
Sheet2.Range(cols(grp, j) & coun).Select
rnge = ActiveCell.Value
If (i = 7 And bool) Or (i = 3 And bool) Then
bool = False
k = k + 1
End If
If i <> 7 And i <> 3 And fir(objCoun) = 1 Then
k = k + 1
End If
coun = coun + 1
oGraph.Application.DataSheet.Range(mon(mo) & k).Value = rnge 'xlwrk.Worksheets("Sheet2").Range(cols(grp, j) & coun) 'rnge
'oGraph.Application.DataSheet.Cells(mo, k).Value = rnge
oGraph.Application.Update
pptApp.ActiveWindow.Selection.Unselect
Set oshape = Nothing
Set oGraph = Nothing
Next
End If
objCoun = objCoun + 1
Next
Next
Next
MsgBox ("done")
Else
MsgBox "Please import the data for correct month"
End If
End Sub