PDA

View Full Version : [SOLVED] Problem with VBA code in Excel



ell_
11-15-2017, 05:18 PM
Hi people,

I have this one VBA code created by someone and my job is to alter the code. My code is this:


Option Explicit


Sub MakePowerpoint()
Dim MyPath As String
Dim FileName As String

Dim objPPT As Object
Dim ppt As Object
Dim sld As Object
Dim shp As Object
Dim PPName As String
Dim shpIndex As Long
Dim CurSlide As Long

Dim sh As Excel.Worksheet
Dim ObjName As String
Dim ObjType As String
Dim PPSldNum As Long
Dim PPObjName As String
Dim MyTop As Double
Dim MyLeft As Double
Dim MyHeight As Double
Dim MyWidth As Double
Dim cl As Range
Dim OldText As String
Dim NewText As String

' Set up the pathname and the output PowerPoint Presentation Name
MyPath = ThisWorkbook.Path
PPName = MyPath & "\" & Range("PPReport_Name")

' Copy the template file to the PowerPoint Presentation Name
FileCopy MyPath & "\" & Range("PPTemplate_Name"), PPName

' Open the PowerPoint Presentation
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
objPPT.presentations.Open PPName

Set ppt = objPPT.activepresentation

' Add objects
For Each cl In Range("Table_Objects[Excel Page]")
ObjType = cl.Offset(0, 2).Value ' Type of the thing to copy
If ObjType <> "Text" Then
Set sh = Sheets(cl.Value) ' Excel Sheet
ObjName = cl.Offset(0, 1).Value ' Name of the thing to copy
End If

PPSldNum = cl.Offset(0, 3).Value ' PowerPoint slide number
PPObjName = cl.Offset(0, 4).Value ' PowerPoint object
MyTop = cl.Offset(0, 5).Value ' Top
MyLeft = cl.Offset(0, 6).Value ' Left
MyHeight = cl.Offset(0, 7).Value ' Height
MyWidth = cl.Offset(0, 8).Value ' Width
OldText = cl.Offset(0, 9).Value ' Old Text
NewText = cl.Offset(0, 10) ' New Text

Set sld = ppt.slides(PPSldNum) ' Active Slide

Select Case ObjType
Case "Text"
sld.Shapes(PPObjName).TextFrame.TextRange.Text = _
Replace(sld.Shapes(PPObjName).TextFrame.TextRange.Text, OldText, NewText)
Case "Chart"
sh.Shapes(ObjName).CopyPicture
Case "Range"
sh.Range(ObjName).CopyPicture
End Select

If ObjType = "Chart" Or ObjType = "Range" Then
sld.Shapes.Paste
shpIndex = sld.Shapes.Count
With sld.Shapes(shpIndex)
.LockAspectRatio = msoFalse
.Top = 72 * MyTop
.Left = 72 * MyLeft
.Height = 72 * MyHeight
.Width = 72 * MyWidth
End With
End If
Next

End Sub

Function GetText(ObjName As String, Pos As Long) As String
Dim cl As Range
Dim Result As String

Result = "Value not found"

For Each cl In Range("Table_TextFrame[PPObjName]")
If cl.Value = ObjName Then
Result = cl.Offset(0, Pos).Value
Exit For
End If
Next
GetText = Result
End Function



The part that I wanna edit is:


Select Case ObjType
Case "Text"
sld.Shapes(PPObjName).TextFrame.TextRange.Text = _
Replace(sld.Shapes(PPObjName).TextFrame.TextRange.Text, OldText, NewText)
Case "Chart"
sh.Shapes(ObjName).CopyPicture
Case "Range"
sh.Range(ObjName).CopyPicture
Case "Cell" 'this part
sh.Range(ObjName).Copy 'for keeping source formatting case'
End Select

If ObjType = "Chart" Or ObjType = "Range" Then
sld.Shapes.Paste
shpIndex = sld.Shapes.Count
With sld.Shapes(shpIndex)
.LockAspectRatio = msoFalse
.Top = 72 * MyTop
.Left = 72 * MyLeft
.Height = 72 * MyHeight
.Width = 72 * MyWidth
End With
End If
If ObjType = "Cell" Then 'this part
sld.Shapes.PasteSpecial ppPasteDefault 'paste as its default form'
shpIndex = sld.Shapes.Count
With sld.Shapes(shpIndex)
.LockAspectRatio = msoFalse
.Top = 72 * MyTop
.Left = 72 * MyLeft
.Height = 72 * MyHeight
.Width = 72 * MyWidth
End With
End If
Next


But whenever I want to try the program I have two issues:
1. The program will highlight
sld.Shapes.PasteSpecial ppPasteDefault 'paste as its default form' and shows an error; either syntax or object not defined
2. Whenever I want to fill in the template, my excel will show this:
20965



The way my program works is that one sheet will contain the details of the data that wants to be copied from Excel to PowerPoint including from which sheet and what kind of data either "range", "chart" or "cell" (the new feature I wanna add to keep source formatting or keeping it as its default form).

Kenneth Hobs
11-15-2017, 06:51 PM
Welcome to the forum!

When using Late Binding, convert Early Binding constants like ppPasteDefault to the constant number instead. ppPasteDefault=0

sld.Shapes.PasteSpecial 0 'ppPasteDefault =0, paste as its default form'

ell_
11-15-2017, 07:24 PM
It works! Thanks Kenneth! It has been weeks for me to find the answer. I also found out that we can also write is as


sld.Shapes.Paste

Update: I have found the solution my second issue which is restriction of putting in values in Excel. How to solve it:

1. Go to Data - Data Validation - Data Validation
2. Edit your Source

Just in case if there's anyone having the same issue.