运行时错误'13' - 类型不匹配

时间:2017-11-28 20:16:46

标签: excel vba powerpoint

我有一个宏来通过先前选择的excel文件替换powerpoint中的标签。但是我有一个错误

  

运行时错误'13' - 类型不匹配

在以下一行:

Destino = ActiveWorkbook.Sheets(SheetDestino).Range(CellDestino).Value

有没有人可以帮我澄清并纠正它?

Dim pPPTFile        As Presentation
Dim sld             As Slide
Dim shp             As Shape
Dim i               As Long
Dim j               As Long
Dim m               As Long
Dim trFoundText     As TextRange
Dim ExcelFile
Dim exl             As Object
Dim WB              As Workbook
Dim WS              As Worksheet

Set exl = CreateObject("Excel.Application")

ExcelFile = exl.Application.GetOpenFilename(, , "Select Excel File")

Workbooks.Open FileName:=ExcelFile

Set pPPTFile = ActivePresentation


Dim Range           As Range
Dim LineRange       As Range
Dim Tag             As Variant
Dim SheetDestino    As Variant
Dim CellDestino     As Variant
Dim Destino         As Object


Set Range = ActiveWorkbook.Sheets("FIM").Range(ActiveWorkbook.Sheets("FIM").Cells(2, 1), ActiveWorkbook.Sheets("FIM").Cells(ActiveWorkbook.Sheets("FIM").Rows.Count, 1).End(xlUp))

For Each LineRange In Range

    Set Tag = LineRange.Offset(0, 6)
    MsgBox (Tag)
    Set SheetDestino = LineRange.Offset(0, 4)
    MsgBox (SheetDestino)
    Set CellDestino = LineRange.Offset(0, 5)
    MsgBox (CellDestino)
    Destino = ActiveWorkbook.Sheets(SheetDestino).Range(CellDestino).Value
    MsgBox (Destino)


    For Each sld In pPPTFile.Slides

        For Each shp In sld.Shapes

            If shp.HasTextFrame Then

                If shp.TextFrame.HasText Then

                    Set trFoundText = shp.TextFrame.TextRange.Find(Tag)

                        If Not (trFoundText Is Nothing) Then
                            m = shp.TextFrame.TextRange.Find(Tag).Characters.Start
                            shp.TextFrame.TextRange.Characters(m).InsertBefore (Destino)
                            shp.TextFrame.TextRange.Find(Tag).Delete

                        End If

                End If

            End If

        If shp.HasTable Then

            For i = 1 To shp.Table.Rows.Count

                For j = 1 To shp.Table.Columns.Count

                    Set trFoundText = shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Find(Tag)
                        If Not (trFoundText Is Nothing) Then
                            m = shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Find(Tag).Characters.Start
                            shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Characters(m).InsertBefore (Destino)
                            shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Find(Tag).Delete

                        End If

                Next j

            Next i

        End If

    Next shp

Next sld

Next LineRange

0 个答案:

没有答案