Вставить ошибку Excel в Powerpoint VBA - PullRequest
0 голосов
/ 26 апреля 2018

Я вставляю некоторые данные Excel в PowerPoint в виде картинки и у меня возникают некоторые проблемы.У меня есть 290 файлов, которые я вставляю в таблицу на слайды 4, 5 и 6 каждого файла PP.Это отлично работало вчера, когда я делал только 1 таблицу на слайде 6. Я повторил процесс, и теперь я продолжаю получать случайные ошибки в случайные моменты времени.Иногда его файл 10, другие файл 50, каждый раз разные.Диапазон ошибок от типа данных вставки недоступен ИЛИ буфер обмена пуст.Я пробовал каждый тип данных, вставляя как метафайл, как форму, как изображение, просто вставляя базовые данные, и ничто не останавливает ошибку.Я понятия не имею!Вот мой код: ПОЖАЛУЙСТА, ПОМОГИТЕ!

Sub Update_Site_Report()

'Initiate Variables
Dim objPPT As Object
Dim PPTPrez As Object
Dim FinSlide As Object
Dim AssumSlide As Object
Dim RiskSlide As Object
Dim FinTable As Object
Dim AssumTable As Object
Dim RiskTable As Object
Dim fileNameString As String
Dim PicCount As Long
Dim PicCount1 As Long
Dim PicCount2 As Long
Dim i As Long
Dim fileN As String
Dim Directory As String


'Create and open powerpoint application

Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True

Application.ScreenUpdating = False

'Update site report table from spreadsheet

For i = 2 To 291
    Sheet20.Cells(18, 2) = Sheet20.Cells(5, i)
    Sheet20.Cells(19, 2) = Sheet20.Cells(6, i)
    Sheet20.Cells(20, 2) = Sheet20.Cells(7, i)
    Sheet20.Cells(21, 2) = Sheet20.Cells(8, i)
    Sheet20.Cells(18, 3) = Sheet20.Cells(10, i)
    Sheet20.Cells(19, 3) = Sheet20.Cells(11, i)
    Sheet20.Cells(20, 3) = Sheet20.Cells(12, i)
    Sheet20.Cells(21, 3) = Sheet20.Cells(13, i)

'Take column header from spreadsheet and set as filename

fileN = Sheet20.Cells(4, i)

' Allow directory to be set in excel tab

Directory = Sheet20.Cells(18, 5)


'Open powerpoint presentation at Directory with Filename

Set PPTPrez = objPPT.Presentations.Open(Directory & fileN & ".pptx")

'Set range for site report table

Set Financials = Sheet20.Range("A17:C21")
Set Assumptions = Sheet45.Range("A1:C7")
Set Risks = Sheet45.Range("A24:D41")

'Choose which slide to paste site report table

Set FinSlide = PPTPrez.Slides(6)
Set AssumSlide = PPTPrez.Slides(4)
Set RiskSlide = PPTPrez.Slides(5)

'If there is a table in powerpoint slide, delete the table

For PicCount1 = AssumSlide.Shapes.Count To 1 Step -1
    If AssumSlide.Shapes(PicCount1).Type = msoPicture Then
        AssumSlide.Shapes(PicCount1).Delete
    End If
Next

For PicCount = FinSlide.Shapes.Count To 1 Step -1
    If FinSlide.Shapes(PicCount).Type = msoPicture Then
        FinSlide.Shapes(PicCount).Delete
    End If
Next

For PicCount2 = RiskSlide.Shapes.Count To 1 Step -1
    If RiskSlide.Shapes(PicCount2).Type = msoPicture Then
        RiskSlide.Shapes(PicCount2).Delete
        Debug.Print
    End If
Next

'Paste the site report table into the site report

Financials.Copy
FinSlide.Shapes.PasteSpecial ppPasteShape
Set FinTable = FinSlide.Shapes(FinSlide.Shapes.Count)

Assumptions.Copy
AssumSlide.Shapes.PasteSpecial ppPasteShape
Set AssumTable = AssumSlide.Shapes(AssumSlide.Shapes.Count)

Risks.Copy
RiskSlide.Shapes.PasteSpecial ppPasteShape
Set RiskTable = RiskSlide.Shapes(RiskSlide.Shapes.Count)

'Set position of site report table in powerpoint

FinTable.Left = 36
FinTable.Top = 175
FinTable.Width = 614

AssumTable.Left = 36
AssumTable.Top = 80.8

RiskTable.Left = 36
RiskTable.Top = 80.8
RiskTable.Width = 641.5


'Set filename as string

fileNameString = Directory & fileN & ".pptx"

'Save file as filename

PPTPrez.SaveAs fileNameString

'Close powerpoint presentation

PPTPrez.Close

'Repeat for every site (column) - increment i

Next i

'quit powerpoint

objPPT.Quit

Application.ScreenUpdating = True

MsgBox ("Update complete, click ok to exit powerpoint")

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...