如何将表格从Excel复制到PowerPoint – VBA
我找不到任何方法来做到这一点。 我现在所拥有的就是把它作为一个图像复制出来：
Dim XLApp As Excel.Application Dim PPSlide As Slide Set XLApp = GetObject(, "Excel.Application") XLApp.Range("A1:B17").Select XLApp.Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture PPSlide.Shapes.Paste.Select 这就像一个魅力，但它有可能得到它复制范围作为一个表而不是图片？
这可以简单地用
Dim XLApp As Excel.Application Dim PPSlide As Slide Set XLApp = GetObject(, "Excel.Application") XLApp.Range("A1:B17").Copy PPSlide.Shapes.PasteSpecial DataType:=ppPasteOLEObject, Link:=msoFalse
那么，如果我手动复制它，我可能会做一个select性粘贴，并select“格式化文本（RTF）”作为types。 我相信你可以模仿在VBA。
编辑
啊，我们走了。 在你的简报中这样做：
- 转到插入 – >对象
- select你的Excel文件。 检查链接选项。
到您的XL文件的链接现在embedded到您的PP文件中。 当XL文件中的数据发生变化时，您可以：
- 通过右键单击 – >更新链接手动更新它。
- 使用类似
ActivePresentation.UpdateLinks东西，通过VBA自动更新它
这是一种非常不同的方法，但是我相信它会让你更接近你的目标。 虽然它有它自己的问题，但是那些可以被解决。
只需要自己解决这个问题。 这里是特别为我工作的粘贴：
XLApp.Selection.Copy PPSlide.Shapes.PasteSpecial DataType:=ppPasteDefault
我在这里find了特殊粘贴选项的完整列表：
http://www.thespreadsheetguru.com/blog/2014/3/17/copy-paste-an-excel-range-into-powerpoint-with-vba
上述提出的解决scheme对我来说并不适用，因为excel表继续作为（不可编辑）图片粘贴在powerpoint中。
要运行pastespecial'Keep Source Formatting'button，请在命令行中运行以下代码：
Application.CommandBars.ExecuteMso ("PasteSourceFormatting")
Microsoft msdn站点上的更多（但有限）信息： https ： //msdn.microsoft.com/en-us/library/office/ff862419.aspx
Sub abc() j = 2 Sheets("sheet1").Select ActiveSheet.Range("a1").Select ActiveSheet.Range("a65536").Select lastrow = Selection.End(xlUp).Row '/// column a ActiveSheet.Range("a3:a" & lastrow).Select Application.CutCopyMode = False Selection.AutoFilter ActiveSheet.Range("$A$3:$A$" & lastrow).AutoFilter Field:=1, Criteria1:="=" Set Rng = ActiveSheet.AutoFilter.Range cnt = Rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 If cnt = 0 Then GoTo label1 End If ActiveSheet.Range("a3:a" & lastrow - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Copy 'Selection.EntireRow.Select ' Range(Selection, Selection.End(xlToRight)).Select rownum = Selection.Row ' If rownum = 3 Then ' Selection.AutoFilter ' GoTo label1 ' End If 'Selection.Copy Sheets("Sheet2").Select 'lrow = ActiveSheet.Range("A65536").End(xlUp).Row lrow = Cells.Find(what:="*", after:=[a1], searchorder:=xlByRows, _ searchdirection:=xlPrevious).Row ActiveSheet.Range("a" & lrow + 1).Select ActiveSheet.Paste Sheets("Sheet1").Select Selection.Offset(1, 0).SpecialCells(xlCellTypeVisible).Select Selection.EntireRow.Delete Application.CutCopyMode = False label1: Selection.AutoFilter 'column b/////////// ActiveSheet.Range("a65536").Select lastrow = Selection.End(xlUp).Row ActiveSheet.Range("b3:b" & lastrow).Select Application.CutCopyMode = False Selection.AutoFilter ActiveSheet.Range("$b$3:$b$" & lastrow).AutoFilter Field:=1, Criteria1:="=" Set Rng = ActiveSheet.AutoFilter.Range cnt = Rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 If cnt = 0 Then GoTo label2 End If ActiveSheet.Range("$b$3:$b$" & lastrow - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Copy 'Range(Selection, Selection.End(xlToLeft)).Select ' ' Selection.EntireRow.Select 'Range(Selection, Selection.End(xlToRight)).Select ' rownum = Selection.Row ' If rownum = 3 Then ' Selection.AutoFilter ' GoTo label2 ' End If ' Selection.Copy Sheets("Sheet2").Select 'lrow = ActiveSheet.Range("A65536").End(xlUp).Row lrow = Cells.Find(what:="*", after:=[a1], searchorder:=xlByRows, _ searchdirection:=xlPrevious).Row ActiveSheet.Range("a" & lrow + 1).Select ActiveSheet.Paste Sheets("Sheet1").Select 'Selection.SpecialCells(xlCellTypeVisible).Select 'Selection.Offset(1, 0).SpecialCells(xlCellTypeVisible).Select ' ' Selection.EntireRow.Delete ActiveSheet.Range("$b$3:$b$" & lastrow - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete Application.CutCopyMode = False label2: Selection.AutoFilter 'column c//////////// ActiveSheet.Range("c65536").Select lastrow = Selection.End(xlUp).Row ActiveSheet.Range("c3:c" & lastrow).Select Application.CutCopyMode = False Selection.AutoFilter ActiveSheet.Range("$c$3:$c$" & lastrow).AutoFilter Field:=1, Criteria1:="SG Plus", _ Operator:=xlOr, Criteria2:="=Select" Set Rng = ActiveSheet.AutoFilter.Range cnt = Rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 If cnt = 0 Then GoTo label3 End If ActiveSheet.Range("$c$3:$c$" & lastrow - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Copy 'Range(Selection, Selection.End(xlToRight)).Select ' Selection.Copy ' Sheets("Sheet2").Select ' lrow = activehseet.Range("A65536").End(xlUp).Row ' ActiveSheet.Range("a" & lrow).Select ' ActiveSheet.Paste ' Sheets("Sheet1").Select ' rownum = Selection.Row ' If rownum = 3 Then ' Selection.AutoFilter ' GoTo label3 ' End If ' Range("a4:a" & lastrow).Select ' Range(Selection, Selection.End(xlToRight)).Select ' Selection.EntireRow.Select ' Selection.SpecialCells(xlCellTypeVisible).Select ActiveSheet.Range("$c$3:$c$" & lastrow - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Select Selection.EntireRow.Delete Application.CutCopyMode = False label3: Selection.AutoFilter 'column c again///////////// ActiveSheet.Range("c65536").Select lastrow = Selection.End(xlUp).Row ActiveSheet.Range("c3:c" & lastrow).Select Application.CutCopyMode = False Selection.AutoFilter ActiveSheet.Range("$c$3:$c$" & lastrow).AutoFilter Field:=1, Criteria1:="=" Set Rng = ActiveSheet.AutoFilter.Range cnt = Rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 If cnt = 0 Then GoTo label4 End If ActiveSheet.Range("$c$3:$c$" & lastrow - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Copy ' rownum = Selection.Row ' If rownum = 3 Then ' Selection.AutoFilter ' GoTo label4 ' End If ' ' Range(Selection, Selection.End(xlToRight)).Select ' ' Range("a4:a" & lastrow).Select ' Range(Selection, Selection.End(xlToRight)).Select ' ' Selection.EntireRow.Copy Sheets("Sheet2").Select 'lrow = ActiveSheet.Range("A65536").End(xlUp).Row lrow = Cells.Find(what:="*", after:=[a1], searchorder:=xlByRows, _ searchdirection:=xlPrevious).Row ActiveSheet.Range("a" & lrow + 1).Select ActiveSheet.Paste Sheets("Sheet1").Select ActiveSheet.Range("$c$3:$c$" & lastrow - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Select ' Selection.SpecialCells(xlCellTypeVisible).Select Selection.EntireRow.Delete Application.CutCopyMode = False label4: Selection.AutoFilter '////////////////////////// over ///////////////////////////// ActiveSheet.Range("a1").Select For i = 4 To lastrow Range("a" & i).Select If Range("a" & i).Value = "MidAmerica" Or Range("a" & i).Value = "Northeast" Or Range("a" & i).Value = "Southeast" Or _ Range("a" & i).Value = "West" Then GoTo cont Else Rows(i).Select Application.CutCopyMode = False Selection.Cut Sheets("Sheet2").Select lrow = Cells.Find(what:="*", after:=[a1], searchorder:=xlByRows, _ searchdirection:=xlPrevious).Row Range("a" & lrow + 1).Select ActiveSheet.Paste j = j + 1 Sheets("sheet1").Select Selection.Delete Shift:=xlUp End If cont: Next i '/////// column b /////////// ActiveSheet.Range("a1").Select For i = 4 To lastrow Range("b" & i).Select If Range("b" & i).Value = "CA" Or Range("b" & i).Value = "AZ" Then GoTo cont2 Else Rows(i).Select Application.CutCopyMode = False Selection.Cut Sheets("Sheet2").Select lrow = Cells.Find(what:="*", after:=[a1], searchorder:=xlByRows, _ searchdirection:=xlPrevious).Row Range("a" & lrow + 1).Select ActiveSheet.Paste j = j + 1 Sheets("sheet1").Select Selection.Delete Shift:=xlUp End If cont2: Next i '///////////column c ////////// ActiveSheet.Range("a1").Select For i = 4 To lastrow Range("c" & i).Select If Range("c" & i).Value = "SG" Then GoTo cont3 Else Rows(i).Select Application.CutCopyMode = False Selection.Cut Sheets("Sheet2").Select lrow = Cells.Find(what:="*", after:=[a1], searchorder:=xlByRows, _ searchdirection:=xlPrevious).Row Range("a" & lrow + 1).Select ActiveSheet.Paste j = j + 1 Sheets("sheet1").Select Selection.Delete Shift:=xlUp End If cont3: Next i '//////////column l///////////// ActiveSheet.Range("a1").Select For i = 4 To lastrow Range("l" & i).Select If Range("l" & i).Value <= "01/06/2014" And Range("l" & i).Value >= "01/01/2013" Then GoTo cont4 Else Rows(i).Select Application.CutCopyMode = False Selection.Cut Sheets("Sheet2").Select lrow = Cells.Find(what:="*", after:=[a1], searchorder:=xlByRows, _ searchdirection:=xlPrevious).Row Range("a" & lrow + 1).Select ActiveSheet.Paste j = j + 1 Sheets("sheet1").Select Selection.Delete Shift:=xlUp End If cont4: Next i '//////////column m///////////// ActiveSheet.Range("a1").Select For i = 4 To lastrow Range("m" & i).Select If Range("m" & i).Value = "12/01" Or Range("m" & i).Value = "12/05" Then GoTo cont5 Else Rows(i).Select Application.CutCopyMode = False Selection.Cut Sheets("Sheet2").Select lrow = Cells.Find(what:="*", after:=[a1], searchorder:=xlByRows, _ searchdirection:=xlPrevious).Row Range("a" & lrow + 1).Select ActiveSheet.Paste j = j + 1 Sheets("sheet1").Select Selection.Delete Shift:=xlUp End If cont5: Next i '//////////column q and r///////////// ActiveSheet.Range("a1").Select For i = 4 To lastrow Range("q" & i).Select If Range("q" & i).Value <> " " And Range("r" & i).Value <> " " And Range("u" & i).Value <> " " _ And Range("z" & i).Value <> " " And Range("aa" & i).Value <> " " And Range("ab" & i).Value <> " " _ And Range("b" & i).Value <> " " And Range("j" & i).Value <> " " Then GoTo cont6 Else Rows(i).Select Application.CutCopyMode = False Selection.Cut Sheets("Sheet2").Select lrow = Cells.Find(what:="*", after:=[a1], searchorder:=xlByRows, _ searchdirection:=xlPrevious).Row Range("a" & lrow + 1).Select ActiveSheet.Paste j = j + 1 Sheets("sheet1").Select Selection.Delete Shift:=xlUp End If cont6: Next i End Sub