CODEWITHSUNDEEP
vbaexcelpowerpoint
ZeldaElf
ZeldaElf

Reputation: 333

Automated transfer of Excel tables to PowerPoint causes unequal border widths

I'm automating the process of sending excels sheets as imgs to a powerpoint presentation, for I need it daily and it's very boring to copy/paste it.

I'm using the following function (activated by a toast in one os the excel's sheets) to copy it:

Sub WorkbooktoPowerPoint()

'Step 1: Declare your variables
Dim pp As Object
Dim PPPres As Object
Dim PPSlide As Object
Dim xlwksht As Worksheet
Dim MyRange As String
Dim MyTitle As String

'Step 2: Open PowerPoint, add a new presentation and make visible
Set pp = CreateObject("PowerPoint.Application")
Set PPPres = pp.Presentations.Add
pp.Visible = True

'Step 3: Set the ranges for your data and title
MyRange = "B2:BH40" '<<

'Step 4: Start the loop through each worksheet
For Each xlwksht In ActiveWorkbook.Worksheets
xlwksht.Select
Application.Wait (Now + TimeValue("0:00:1"))

'Step 5: Copy the range as picture
xlwksht.Range(MyRange).CopyPicture _
Appearance:=xlScreen, Format:=xlPicture

'Step 6: Count slides and add new blank slide as next available slide number
'(the number 12 represents the enumeration for a Blank Slide)
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, 12)
PPSlide.Select

'Step 7: Paste the picture and adjust its position
PPSlide.Shapes.Paste.Select
pp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
pp.ActiveWindow.Selection.ShapeRange.Top = 1
pp.ActiveWindow.Selection.ShapeRange.Left = 1
pp.ActiveWindow.Selection.ShapeRange.Width = 700

'Step 8: Add the title to the slide then move to next worksheet
Next xlwksht

'Step 9: Memory Cleanup
pp.Activate
Set PPSlide = Nothing
Set PPPres = Nothing
Set pp = Nothing

End Sub

It works greatly, but my problem is: Those sheets that have tables are copied and show bold lines in random borders of the table (imagine a bordered table with thin lines and a Thick line next to it, where it shouldn't be.)

It seems that, when we use zoom-in and zoom-out, this problema vanishes, but in the full screen presentation it remains. For me it looks like a Microsoft Excel problem, but maybe someone could help...

Thanks a lot!

Upvotes: 1

Views: 687

Answers (1)

David Zemens
David Zemens

Reputation: 53623

Try changing step 5 to use bitmap format instead:

'Step 5: Copy the range as picture
xlwksht.Range(MyRange).CopyPicture _
Appearance:=xlScreen, Format:=xlBitmap

Upvotes: 1

Related Questions