Consulting

Results 1 to 3 of 3

Thread: Problem with VBA code in Excel

  1. #1
    VBAX Regular
    Joined
    Nov 2017
    Posts
    22
    Location

    Exclamation Problem with VBA code in Excel

    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:
    Capture.jpg



    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).

  2. #2
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    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'

  3. #3
    VBAX Regular
    Joined
    Nov 2017
    Posts
    22
    Location
    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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •