Unlock a world of possibilities! Login now and discover the exclusive benefits awaiting you.
Good day!
Colleagues, in my model i have function which export data to PPT:
Sub Export_MyFun
Set objPPT = CreateObject("PowerPoint.Application")
Set objPresentation = objPPT.Presentations.Open("MyDir\Brand_Scorecard_Template.ppt")
Set PPSlide = objPresentation.Slides(1)
ActiveDocument.GetSheetObject("TX2894").CopyBitmapToClipboard
objPPT.Visible = True
PPSlide.Shapes.Paste
PPSlide.Shapes(PPSlide.Shapes.Count).Top = 10 'This sets the top location of the image
PPSlide.Shapes(PPSlide.Shapes.Count).Left = 195'This sets the left location
PPSlide.Shapes(PPSlide.Shapes.Count).Width = 452
PPSlide.Shapes(PPSlide.Shapes.Count).Height = 25
ActiveDocument.GetSheetObject("CH1126").CopyBitmapToClipboard
objPPT.Visible = True
PPSlide.Shapes.Paste
PPSlide.Shapes(PPSlide.Shapes.Count).Top = 56 'This sets the top location of the image 1
PPSlide.Shapes(PPSlide.Shapes.Count).Left = 65 'This sets the left location
PPSlide.Shapes(PPSlide.Shapes.Count).Width = 385
PPSlide.Shapes(PPSlide.Shapes.Count).Height = 110
'Set PPSlide = objPresentation.Slides.Add(1,12)
ActiveDocument.GetSheetObject("CH1125").CopyBitmapToClipboard
PPSlide.Shapes.Paste
PPSlide.Shapes(PPSlide.Shapes.Count).Top = 56 'This sets the top location of the image 2
PPSlide.Shapes(PPSlide.Shapes.Count).Left = 345 'This sets the left location
PPSlide.Shapes(PPSlide.Shapes.Count).Width = 452
PPSlide.Shapes(PPSlide.Shapes.Count).Height = 110
ActiveDocument.GetSheetObject("CH1124").CopyBitmapToClipboard
PPSlide.Shapes.Paste
PPSlide.Shapes(PPSlide.Shapes.Count).Top = 166 'This sets the top location of the image 3
PPSlide.Shapes(PPSlide.Shapes.Count).Left = 65 'This sets the left location
PPSlide.Shapes(PPSlide.Shapes.Count).Width = 387
PPSlide.Shapes(PPSlide.Shapes.Count).Height = 109
ActiveDocument.GetSheetObject("CH1123").CopyBitmapToClipboard
PPSlide.Shapes.Paste
PPSlide.Shapes(PPSlide.Shapes.Count).Top = 166 'This sets the top location of the image 4
PPSlide.Shapes(PPSlide.Shapes.Count).Left = 345 'This sets the left location
PPSlide.Shapes(PPSlide.Shapes.Count).Width = 452
PPSlide.Shapes(PPSlide.Shapes.Count).Height = 110
ActiveDocument.GetSheetObject("CH1131").CopyBitmapToClipboard
PPSlide.Shapes.Paste
PPSlide.Shapes(PPSlide.Shapes.Count).Top = 275 'This sets the top location of the image 5
PPSlide.Shapes(PPSlide.Shapes.Count).Left = 65 'This sets the left location
PPSlide.Shapes(PPSlide.Shapes.Count).Width = 96
PPSlide.Shapes(PPSlide.Shapes.Count).Height = 127
ActiveDocument.GetSheetObject("CH1130").CopyBitmapToClipboard
PPSlide.Shapes.Paste
PPSlide.Shapes(PPSlide.Shapes.Count).Top = 275 'This sets the top location of the image 6
PPSlide.Shapes(PPSlide.Shapes.Count).Left = 175 'This sets the left location
PPSlide.Shapes(PPSlide.Shapes.Count).Width = 199
PPSlide.Shapes(PPSlide.Shapes.Count).Height = 127
ActiveDocument.GetSheetObject("CH1129").CopyBitmapToClipboard
PPSlide.Shapes.Paste
PPSlide.Shapes(PPSlide.Shapes.Count).Top = 275 'This sets the top location of the image 7
PPSlide.Shapes(PPSlide.Shapes.Count).Left = 283 'This sets the left location
PPSlide.Shapes(PPSlide.Shapes.Count).Width = 199
PPSlide.Shapes(PPSlide.Shapes.Count).Height = 127
ActiveDocument.GetSheetObject("CH1132").CopyBitmapToClipboard
PPSlide.Shapes.Paste
PPSlide.Shapes(PPSlide.Shapes.Count).Top = 275 'This sets the top location of the image 8
PPSlide.Shapes(PPSlide.Shapes.Count).Left = 399 'This sets the left location
PPSlide.Shapes(PPSlide.Shapes.Count).Width = 105
PPSlide.Shapes(PPSlide.Shapes.Count).Height = 127
ActiveDocument.GetSheetObject("CH1133").CopyBitmapToClipboard
PPSlide.Shapes.Paste
PPSlide.Shapes(PPSlide.Shapes.Count).Top = 275 'This sets the top location of the image 9
PPSlide.Shapes(PPSlide.Shapes.Count).Left = 522 'This sets the left location
PPSlide.Shapes(PPSlide.Shapes.Count).Width = 133
PPSlide.Shapes(PPSlide.Shapes.Count).Height = 127
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End Sub
It works correctly with MS Office 2010. But when MS Office was install to 2007 macro doesn't work.
Please, advice, how to solve this problem?
Thanks!
Hi,
Try adding a line like below,
Sub Export_MyFun
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
Set objPresentation = objPPT.Presentations.Open("MyDir\Brand_Scorecard_Template.ppt")
Set PPSlide = objPresentation.Slides(1)
ActiveDocument.GetSheetObject("TX2894").CopyBitmapToClipboard
objPPT.Visible = True
PPSlide.Shapes.Paste
PPSlide.Shapes(PPSlide.Shapes.Count).Top = 10 'This sets the top location of the image
PPSlide.Shapes(PPSlide.Shapes.Count).Left = 195'This sets the left location
PPSlide.Shapes(PPSlide.Shapes.Count).Width = 452
PPSlide.Shapes(PPSlide.Shapes.Count).Height = 25
ActiveDocument.GetSheetObject("CH1126").CopyBitmapToClipboard
objPPT.Visible = True
PPSlide.Shapes.Paste
PPSlide.Shapes(PPSlide.Shapes.Count).Top = 56 'This sets the top location of the image 1
PPSlide.Shapes(PPSlide.Shapes.Count).Left = 65 'This sets the left location
PPSlide.Shapes(PPSlide.Shapes.Count).Width = 385
PPSlide.Shapes(PPSlide.Shapes.Count).Height = 110
'Set PPSlide = objPresentation.Slides.Add(1,12)
ActiveDocument.GetSheetObject("CH1125").CopyBitmapToClipboard
PPSlide.Shapes.Paste
PPSlide.Shapes(PPSlide.Shapes.Count).Top = 56 'This sets the top location of the image 2
PPSlide.Shapes(PPSlide.Shapes.Count).Left = 345 'This sets the left location
PPSlide.Shapes(PPSlide.Shapes.Count).Width = 452
PPSlide.Shapes(PPSlide.Shapes.Count).Height = 110
ActiveDocument.GetSheetObject("CH1124").CopyBitmapToClipboard
PPSlide.Shapes.Paste
PPSlide.Shapes(PPSlide.Shapes.Count).Top = 166 'This sets the top location of the image 3
PPSlide.Shapes(PPSlide.Shapes.Count).Left = 65 'This sets the left location
PPSlide.Shapes(PPSlide.Shapes.Count).Width = 387
PPSlide.Shapes(PPSlide.Shapes.Count).Height = 109
ActiveDocument.GetSheetObject("CH1123").CopyBitmapToClipboard
PPSlide.Shapes.Paste
PPSlide.Shapes(PPSlide.Shapes.Count).Top = 166 'This sets the top location of the image 4
PPSlide.Shapes(PPSlide.Shapes.Count).Left = 345 'This sets the left location
PPSlide.Shapes(PPSlide.Shapes.Count).Width = 452
PPSlide.Shapes(PPSlide.Shapes.Count).Height = 110
ActiveDocument.GetSheetObject("CH1131").CopyBitmapToClipboard
PPSlide.Shapes.Paste
PPSlide.Shapes(PPSlide.Shapes.Count).Top = 275 'This sets the top location of the image 5
PPSlide.Shapes(PPSlide.Shapes.Count).Left = 65 'This sets the left location
PPSlide.Shapes(PPSlide.Shapes.Count).Width = 96
PPSlide.Shapes(PPSlide.Shapes.Count).Height = 127
ActiveDocument.GetSheetObject("CH1130").CopyBitmapToClipboard
PPSlide.Shapes.Paste
PPSlide.Shapes(PPSlide.Shapes.Count).Top = 275 'This sets the top location of the image 6
PPSlide.Shapes(PPSlide.Shapes.Count).Left = 175 'This sets the left location
PPSlide.Shapes(PPSlide.Shapes.Count).Width = 199
PPSlide.Shapes(PPSlide.Shapes.Count).Height = 127
ActiveDocument.GetSheetObject("CH1129").CopyBitmapToClipboard
PPSlide.Shapes.Paste
PPSlide.Shapes(PPSlide.Shapes.Count).Top = 275 'This sets the top location of the image 7
PPSlide.Shapes(PPSlide.Shapes.Count).Left = 283 'This sets the left location
PPSlide.Shapes(PPSlide.Shapes.Count).Width = 199
PPSlide.Shapes(PPSlide.Shapes.Count).Height = 127
ActiveDocument.GetSheetObject("CH1132").CopyBitmapToClipboard
PPSlide.Shapes.Paste
PPSlide.Shapes(PPSlide.Shapes.Count).Top = 275 'This sets the top location of the image 8
PPSlide.Shapes(PPSlide.Shapes.Count).Left = 399 'This sets the left location
PPSlide.Shapes(PPSlide.Shapes.Count).Width = 105
PPSlide.Shapes(PPSlide.Shapes.Count).Height = 127
ActiveDocument.GetSheetObject("CH1133").CopyBitmapToClipboard
PPSlide.Shapes.Paste
PPSlide.Shapes(PPSlide.Shapes.Count).Top = 275 'This sets the top location of the image 9
PPSlide.Shapes(PPSlide.Shapes.Count).Left = 522 'This sets the left location
PPSlide.Shapes(PPSlide.Shapes.Count).Width = 133
PPSlide.Shapes(PPSlide.Shapes.Count).Height = 127
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End Sub
Thanks.
But it doesn't work.
You can check it in attached example model.
It's woking fine in my system and screen shot attached for your reference. I'm using MS office 2007. I guess, you forgot to change the current local security level to "Allow System Access"
I change Current Local Security.
But it also doesn't work.
When i work with this model on my desktop Account (where MS Office 2010), it works fine, but on server (where where MS Office 2007) it doesn't work.
Just try this code alone and see whether power point window is visible or not.
Sub Export_MyFun
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
Set objPresentation = objPPT.Presentations.Add
End Sub
Not, any reaction ...
I am not sure why this code is not running in your server. Go to run (Windows key + R) and type Powerpnt. Check whether powerpoint opening or not.
yes. it works..
but in qv macro it doesn't run..(