проблема с копированием диаграмм в powerpoint - PullRequest
0 голосов
/ 23 сентября 2019

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

Sub copiarChartPPT(ByVal sector As Integer, ByVal nchart As Integer, ByVal myPresentation As Object, ByVal s6s As Boolean, ByVal chartnum As Integer)

Dim pslide As Integer
Dim chartname As String
Dim mySlide As Object
Dim myShape As Object


'Copiar o grafico
Workbooks(arq).Activate
Sheets("LNCELL").Select
ActiveSheet.ChartObjects(chartnum).Chart.ChartArea.Copy


'Colar no powerpoint
If s6s Then
'6 Sectores
    If sector = 1 Then
        pslide = Sheets("Config").Cells(nchart + 26, "B")
        Set mySlide = myPresentation.Slides(pslide)
        mySlide.Shapes.PasteSpecial DataType:=2
        Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
        With myShape
            .LockAspectRatio = False
            .Left = Sheets("Config").Cells(nchart + 26, "C")
            .Top = Sheets("Config").Cells(nchart + 26, "D")
            .Width = Sheets("Config").Cells(nchart + 26, "E")
            .Height = Sheets("Config").Cells(nchart + 26, "F")
        End With
        Application.CutCopyMode = False
    ElseIf sector = 2 Then
        pslide = Sheets("Config").Cells(nchart + 26, "I")
        Set mySlide = myPresentation.Slides(pslide)
        mySlide.Shapes.PasteSpecial DataType:=2
        Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
            With myShape
            .LockAspectRatio = False
            .Left = Sheets("Config").Cells(nchart + 26, "J")
            .Top = Sheets("Config").Cells(nchart + 26, "K")
            .Width = Sheets("Config").Cells(nchart + 26, "L")
            .Height = Sheets("Config").Cells(nchart + 26, "M")
        End With
        Application.CutCopyMode = False
    ElseIf sector = 3 Then
        pslide = Sheets("Config").Cells(nchart + 26, "P")
        Set mySlide = myPresentation.Slides(pslide)
        mySlide.Shapes.PasteSpecial DataType:=2
        Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
            With myShape
            .LockAspectRatio = False
            .Left = Sheets("Config").Cells(nchart + 26, "Q")
            .Top = Sheets("Config").Cells(nchart + 26, "R")
            .Width = Sheets("Config").Cells(nchart + 26, "S")
            .Height = Sheets("Config").Cells(nchart + 26, "T")
        End With
        Application.CutCopyMode = False
    ElseIf sector = 4 Then
        pslide = Sheets("Config").Cells(nchart + 26, "W")
        Set mySlide = myPresentation.Slides(pslide)
        mySlide.Shapes.PasteSpecial DataType:=2
        Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
            With myShape
            .LockAspectRatio = False
            .Left = Sheets("Config").Cells(nchart + 26, "X")
            .Top = Sheets("Config").Cells(nchart + 26, "Y")
            .Width = Sheets("Config").Cells(nchart + 26, "Z")
            .Height = Sheets("Config").Cells(nchart + 26, "AA")
        End With
        Application.CutCopyMode = False
    ElseIf sector = 5 Then
        pslide = Sheets("Config").Cells(nchart + 26, "AD")
        Set mySlide = myPresentation.Slides(pslide)
        mySlide.Shapes.PasteSpecial DataType:=2
        Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
            With myShape
            .LockAspectRatio = False
            .Left = Sheets("Config").Cells(nchart + 26, "AE")
            .Top = Sheets("Config").Cells(nchart + 26, "AF")
            .Width = Sheets("Config").Cells(nchart + 26, "AG")
            .Height = Sheets("Config").Cells(nchart + 26, "AH")
        End With
        Application.CutCopyMode = False
    ElseIf sector = 6 Then
        pslide = Sheets("Config").Cells(nchart + 26, "AK")
        Set mySlide = myPresentation.Slides(pslide)
        mySlide.Shapes.PasteSpecial DataType:=2
        Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
            With myShape
            .LockAspectRatio = False
            .Left = Sheets("Config").Cells(nchart + 26, "AL")
            .Top = Sheets("Config").Cells(nchart + 26, "AM")
            .Width = Sheets("Config").Cells(nchart + 26, "AN")
            .Height = Sheets("Config").Cells(nchart + 26, "AO")
        End With
        Application.CutCopyMode = False
    End If
    '3 Sectores
Else
    If sector = 1 Then
        pslide = Sheets("Config").Cells(nchart + 1, "B")
        Set mySlide = myPresentation.Slides(pslide)
        mySlide.Shapes.PasteSpecial DataType:=2
        Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
        With myShape
            .LockAspectRatio = False
            .Left = Sheets("Config").Cells(nchart + 1, "C")
            .Top = Sheets("Config").Cells(nchart + 1, "D")
            .Width = Sheets("Config").Cells(nchart + 1, "E")
            .Height = Sheets("Config").Cells(nchart + 1, "F")
        End With
        Application.CutCopyMode = False
    ElseIf sector = 2 Then
        pslide = Sheets("Config").Cells(nchart + 1, "I")
        Set mySlide = myPresentation.Slides(pslide)
        mySlide.Shapes.PasteSpecial DataType:=2
        Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
            With myShape
            .LockAspectRatio = False
            .Left = Sheets("Config").Cells(nchart + 1, "J")
            .Top = Sheets("Config").Cells(nchart + 1, "K")
            .Width = Sheets("Config").Cells(nchart + 1, "L")
            .Height = Sheets("Config").Cells(nchart + 1, "M")
        End With
        Application.CutCopyMode = False
    ElseIf sector = 3 Then
        pslide = Sheets("Config").Cells(nchart + 1, "P")
        Set mySlide = myPresentation.Slides(pslide)
        mySlide.Shapes.PasteSpecial DataType:=2
        Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
            With myShape
            .LockAspectRatio = False
            .Left = Sheets("Config").Cells(nchart + 1, "Q")
            .Top = Sheets("Config").Cells(nchart + 1, "R")
            .Width = Sheets("Config").Cells(nchart + 1, "S")
            .Height = Sheets("Config").Cells(nchart + 1, "T")
        End With
        Application.CutCopyMode = False
    End If
End If


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