0
我想從Excel粘貼表格到Powerpoint並保持源格式(作爲表格)。如何粘貼表格並將格式從Excel轉換爲Powerpoint?
目前使用該貼:
'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecial DataType:=ppPasteSourceFormatting, DisplayAsIcon:=msoFalse
Set myShapeRange = mySlide.Shapes(mySlide.Shapes.Count)
這是以前的工作,但當時我沒有選擇的動態範圍,並從它創建一個表,表中已經存在,此代碼工作正常。
今天我嘗試了很多不同的東西,但是我對VB的瞭解還不足以解決問題。希望有人能成爲我的救星!
整個代碼如下:
Sub ExcelRangeToPowerPoint()
'PURPOSE: Copy/Paste An Excel Range Into a New PowerPoint Presentation
Dim rng As Excel.Range
Dim PowerPointApp As PowerPoint.Application
Dim myPresentation As PowerPoint.Presentation
Dim mySlide As PowerPoint.Slide
Dim myShapeRange As PowerPoint.Shape
'Refresh UsedRange (get rid of "Ghost" cells)
Worksheets("Task List1").UsedRange
'Select UsedRange
Worksheets("Task List1").UsedRange.Select
ActiveSheet.ListObjects.Add(xlSrcRange, ActiveSheet.UsedRange, , xlYes).Name = "Table1"
Range("Table1[#All]").Select
ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleMedium9"
Range("I10").Select
'Copy Range from Excel
Set rng = ActiveSheet.ListObjects(1).Range
'Create an Instance of PowerPoint
On Error Resume Next
'Is PowerPoint already opened?
Set PowerPointApp = GetObject(class:="PowerPoint.Application")
'Clear the error between errors
Err.Clear
'If PowerPoint is not already open then open PowerPoint
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0
'Make PowerPoint Visible and Active
PowerPointApp.Visible = True
PowerPointApp.Activate
'Create a New Presentation
Set myPresentation = PowerPointApp.Presentations.Open("Y:\Projects\VBa\2932 2 Milestones.pptx")
'Add a slide to the Presentation
Set mySlide = myPresentation.Slides.Item(1)
'Delete Current table from Powerpoint
myPresentation.Slides(1).Shapes(2).Delete
'Wait for a few seconds to catch up
Application.Wait (Now + TimeValue("0:00:3"))
'Copy Excel Range
rng.Copy
'ActiveSheet.ListObjects(1).Range.Copy
'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecial DataType:=ppPasteSourceFormatting, DisplayAsIcon:=msoFalse
'PowerPointApp.CommandBars.ExecuteMso ("PasteSourceFormatting")
Set myShapeRange = mySlide.Shapes(mySlide.Shapes.Count)
'Set position:
myShapeRange.Left = 20
myShapeRange.Top = 100
myShapeRange.Height = 400
myShapeRange.Width = 675
'Clear The Clipboard
Application.CutCopyMode = False
End Sub
這不是VB.Net代碼。請刪除標籤 – Plutonix
你有沒有試過把它作爲圖像複製? –
FYR ... http://stackoverflow.com/questions/25558354/best-way-to-copy-excel-table-into-powerpoint-2010 – Linga