Блог

Я пишу код VBA для создания PowerPoint из документа Excel. У меня открывается PowerPoint и экспортируется мой текст, но я сталкиваюсь с проблемой синтаксиса, потому что я хочу экспортировать текст, а не таблицу, растровое изображение, картинку и т. Д.

Я попробовал следующий синтаксис и столкнулся с ошибками.

Первый:

 slde.Shapes.PasteSpecial ppPasteBitmap 
 

(наряду со всеми другими возможными опциями «ppPaste …»)

Второй:

 slde.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
        Left:=1, Top:=1, Width:=100, Height:=100)  
 

Это дает мне ошибки с размерами, даже когда я скопировал чужой рабочий код, чтобы проверить его.

Есть ли лучший способ экспортировать текст? Спасибо.

Код:

 Sub ExporttoPPT()

    Dim ppt_app As New PowerPoint.Application
    Dim pre As PowerPoint.Presentation
    Dim slde As PowerPoint.Slide
    Dim shpe As PowerPoint.shape
    Dim wb As Workbook
    Dim Rng As Range
    
    Dim vSheet As String
    Dim vRange$
    Dim vWidth As Double
    Dim vHeight As Double
    Dim vTop As Double
    Dim vLeft As Double
    Dim vSlide_No As Long
    Dim expRng As Range
    
    Dim adminSh As Worksheet
    Dim cofigRng As Range
    Dim xlfile$
    Dim pptfile$
    
    Dim pptapp As Object
   
    
    Application.DisplayAlerts = False
    
    Set adminSh = ThisWorkbook.Sheets("PPTPage")
    Set cofigRng = adminSh.Range("Rngsheets")
    

    pptfile = adminSh.[pptpth]
    
    Set wb = ActiveWorkbook
    Set pre = ppt_app.Presentations.Open(pptfile)
    
    '---set variables
    For Each Rng In cofigRng
    
        With adminSh
            vSheet = .Cells(Rng.Row, 3).Value
            vRange$ = .Cells(Rng.Row, 4).Value
            vWidth = .Cells(Rng.Row, 5).Value
            vHeight = .Cells(Rng.Row, 6).Value
            vTop = .Cells(Rng.Row, 7).Value
            vLeft = .Cells(Rng.Row, 8).Value
            vSlide_No = Cells(Rng.Row, 9).Value
            Debug.Print vSheet
            Debug.Print vRange$
            Debug.Print vWidth
            Debug.Print vHeight
            Debug.Print vTop
            Debug.Print vLeft
            Debug.Print vSlide_No
        End With
        
    '---export to ppt
            
            wb.Activate
            Sheets(vSheet).Activate
            Set expRng = Sheets(vSheet).Range(vRange$)
            expRng.Copy
            
            Set slde = pre.Slides(vSlide_No)
            
            slde.Shapes.PasteSpecial ppPasteBitmap
            slde.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
            Left:=1, Top:=1, Width:=100, Height:=100)
            
            
            Set shp = slde.Shapes(1)
            
            With shp
                .Top = vTop
                .Left = vLeft
                .Width = vWidth
                .Height = vHeight
        
            End With
        
        Set shp = Nothing
        Set slde = Nothing
        
        
        Application.CutCopyMode = False
        Set expRng = Nothing
    Next Rng
    
    Set pre = Nothing
    
    
    'wb.Close False
    'Set wb = Nothing
    
Application.DisplayAlerts = True
End Sub