VBA从Excel复制到PowerPoint(不是复制粘贴)
我正在尝试将格式化的文本内容从Excel复制到VBA中的Powerpoint,最好不要进行复制和粘贴,因为每次我运行它时,它都会崩溃(即使有多个DoEvents会减慢速度……有数百个单元格的格式很重的文本) 这就是为什么我一直试图通过像下面代码中那样直接寻址单元格来让它工作的原因VBA从Excel复制到PowerPoint(不是复制粘贴),excel,vba,powerpoint,Excel,Vba,Powerpoint,我正在尝试将格式化的文本内容从Excel复制到VBA中的Powerpoint,最好不要进行复制和粘贴,因为每次我运行它时,它都会崩溃(即使有多个DoEvents会减慢速度……有数百个单元格的格式很重的文本) 这就是为什么我一直试图通过像下面代码中那样直接寻址单元格来让它工作的原因 For i = 1 To WS.Range("A65536").End(xlUp).Row If WS.Cells(i, 1) > 0 Then Set newSlide = A
For i = 1 To WS.Range("A65536").End(xlUp).Row
If WS.Cells(i, 1) > 0 Then
Set newSlide = ActivePresentation.Slides(1).Duplicate
newSlide.MoveTo (ActivePresentation.Slides.Count)
With newSlide.Shapes(1).TextFrame.TextRange
.Text = WS.Cells(i, 1).Value ' Inserts the (non-formatted) text from Excel. Have also tried WS.Cells(i, 1).Text
.Font.Name = WS.Cells(i, 1).Font.Name ' This works fine
.Font.Size = WS.Cells(i, 1).Font.Size ' This works fine too
' Neither of the below work because there is a mixture of font styled and colours within individual cells
.Font.FontStyle = WS.Cells(i, 1).Font.FontStyle ' Font Style (Regular, Bold, Italic, Bold Italic)
.Font.Color = WS.Cells(i, 1).Font.Color ' Font Color
End With
End If
Next
它可以(非常快速)传输单元格内容、字体名称和字体大小。。。但不适用于FontStyle(粗体、斜体等)或FontColor,因为单个单元格中有多个样式/颜色
这有什么办法吗?我对潜在的解决方案(如果有的话)一无所知,所以我甚至不知道从哪里开始寻找。即使是朝着正确的方向推进,也会大有裨益 这是一个概念证明 将单元格从excel复制到powerPoint
Sub copyMultipleColorTextPerCell()
' this program copies excel cells that contain multiply formatted text in each cell
' the text is copiend into an msWord document, because the formatting is retained
' and then copied into powerpoint
' -------------------------- create powerpoint presentation
Const ppLayoutBlank = 12
Dim ppApp As PowerPoint.Application
On Error Resume Next
Set ppApp = GetObject(, "PowerPoint.Application")
On Error GoTo 0
If ppApp Is Nothing Then
Set ppApp = New PowerPoint.Application
End If
ppApp.Visible = True
Dim ppPres As Presentation
Set ppPres = ppApp.Presentations.Add
Dim ppSlid As PowerPoint.Slide
Set ppSlid = ppPres.Slides.Add(1, 1)
ppSlid.Layout = ppLayoutBlank
Dim ppShp As PowerPoint.Shape
Set ppShp = ppPres.Slides(1).Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, 500, 200)
Dim ppTxRng As PowerPoint.TextRange
Set ppTxRng = ppShp.TextFrame.TextRange
' ---------------------------------------------------------------
Dim wdApp As Word.Application ' not necessary
Set wdApp = New Word.Application
Dim xlRng As Excel.Range
Set xlRng = Sheets("Sheet1").Range("c6:c7") ' this is the range that gets copied into powerPoint, via msWord
xlRng.Cells(1) = "this is multicolor text" ' some multicolour test text, so you don't have to type any
xlRng.Cells(1).Characters(1, 13).Font.Color = vbGreen
xlRng.Cells(1).Characters(14, 20).Font.Color = vbRed
xlRng.Cells(2) = "this is also multicolor"
xlRng.Cells(2).Characters(1, 12).Font.Color = vbBlue
xlRng.Cells(2).Characters(13, 20).Font.Color = vbMagenta
Dim wdDoc As Word.Document
Set wdDoc = New Word.Document
Dim wdRng As Word.Range
Set wdRng = wdDoc.Range
xlRng.Copy ' copy whole excel range
wdRng.PasteExcelTable False, False, False ' paste to msWord doc, because formatting is kept
Dim wdTb As Table
Set wdTb = wdDoc.Tables(1)
' copy the two cells from msWord table
wdDoc.Range(start:=wdTb.Cell(1, 1).Range.start, End:=wdTb.Cell(2, 1).Range.End).Copy
ppTxRng.Paste ' paste into powerPoint text table
ppTxRng.PasteSpecial ppPasteRTF
Stop ' admire result ...... LOL
wdDoc.Close False
ppPres.Close
ppApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing
Set ppSlid = Nothing
Set ppPres = Nothing
Set ppApp = Nothing
End Sub
详细信息:每个单元格有多个文本格式
通过复制到msWord文档,然后从msWord复制到powerPoint来实现
Sub copyMultipleColorTextPerCell()
' this program copies excel cells that contain multiply formatted text in each cell
' the text is copiend into an msWord document, because the formatting is retained
' and then copied into powerpoint
' -------------------------- create powerpoint presentation
Const ppLayoutBlank = 12
Dim ppApp As PowerPoint.Application
On Error Resume Next
Set ppApp = GetObject(, "PowerPoint.Application")
On Error GoTo 0
If ppApp Is Nothing Then
Set ppApp = New PowerPoint.Application
End If
ppApp.Visible = True
Dim ppPres As Presentation
Set ppPres = ppApp.Presentations.Add
Dim ppSlid As PowerPoint.Slide
Set ppSlid = ppPres.Slides.Add(1, 1)
ppSlid.Layout = ppLayoutBlank
Dim ppShp As PowerPoint.Shape
Set ppShp = ppPres.Slides(1).Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, 500, 200)
Dim ppTxRng As PowerPoint.TextRange
Set ppTxRng = ppShp.TextFrame.TextRange
' ---------------------------------------------------------------
Dim wdApp As Word.Application ' not necessary
Set wdApp = New Word.Application
Dim xlRng As Excel.Range
Set xlRng = Sheets("Sheet1").Range("c6:c7") ' this is the range that gets copied into powerPoint, via msWord
xlRng.Cells(1) = "this is multicolor text" ' some multicolour test text, so you don't have to type any
xlRng.Cells(1).Characters(1, 13).Font.Color = vbGreen
xlRng.Cells(1).Characters(14, 20).Font.Color = vbRed
xlRng.Cells(2) = "this is also multicolor"
xlRng.Cells(2).Characters(1, 12).Font.Color = vbBlue
xlRng.Cells(2).Characters(13, 20).Font.Color = vbMagenta
Dim wdDoc As Word.Document
Set wdDoc = New Word.Document
Dim wdRng As Word.Range
Set wdRng = wdDoc.Range
xlRng.Copy ' copy whole excel range
wdRng.PasteExcelTable False, False, False ' paste to msWord doc, because formatting is kept
Dim wdTb As Table
Set wdTb = wdDoc.Tables(1)
' copy the two cells from msWord table
wdDoc.Range(start:=wdTb.Cell(1, 1).Range.start, End:=wdTb.Cell(2, 1).Range.End).Copy
ppTxRng.Paste ' paste into powerPoint text table
ppTxRng.PasteSpecial ppPasteRTF
Stop ' admire result ...... LOL
wdDoc.Close False
ppPres.Close
ppApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing
Set ppSlid = Nothing
Set ppPres = Nothing
Set ppApp = Nothing
End Sub
可能对某些工作表单元格应用了条件格式。如果这样做,则必须使用范围的
DisplayFormat
属性。例如,.Font.Color=WS.Cells(i,1).DisplayFormat.Font.Color
等。。。。。(这是因为条件格式层将格式设置为单元格,顶部格式就是您看到的格式。)。。。。。。。DisplayFormat可从Excel 2010开始使用,只需将.Font
替换为.DisplayFormat.Font
代码中的任何地方(在分配语句的Excel端),谢谢您的帮助jsotola。当单元格中的所有文本都是粗体时,DisplayFormat似乎工作正常。。。或者用斜体。。。或者是单色的。然而,在我的电子表格中,每个单元格都混合了这些元素。例如,在某些单元格中有一些粗体字,而其他单元格中有一些非粗体字。。。都在同一个牢房里。在其他单元格中,一些单词是黑色的,一些单词是红色的。。。同样地,所有这些都在同一个单元中。(这有意义吗?我想我的问题可能没有把这部分说清楚。)(将.DisplayFormat与这种样式/颜色混合使用会导致错误:“运行时错误438。对象不支持此属性或方法”),我只是重新阅读了你的问题。您是说单元格中的部分文本是一种样式,而该单元格中的其余文本是另一种样式吗?(指颜色、字体等)