VBA代码,用于格式化从Excel复制到PowerpoInt的文本

时间:2017-05-17 22:15:16

标签: excel vba excel-vba powerpoint powerpoint-vba

我从Excel中将文本粘贴到PowerPoint后,无法确定如何设置文本格式。我的代码正确地复制了文本,但我似乎无法正确格式化。我将多列文本复制到每个部门标题下的每张幻灯片中。我已经包含了一个循环,因为我将为每个经理为多个幻灯片执行此操作。但是,我粘贴它后,我不知道如何将列放在幻灯片上。我会很感激我应该做些什么的帮助或建议?

Sub CreateNewPresentation()

Dim myData As Excel.Range
Set myData = Range("D3:E1000")

Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim ppSlide As PowerPoint.Slide

Set ppApp = New PowerPoint.Application

ppApp.Visible = True
ppApp.Activate

Set ppPres = ppApp.Presentations.Add

Set ppSlide = ppPres.Slides.Add(1, ppLayoutTitle)

ppSlide.Shapes(1).TextFrame.TextRange = "Title of Powerpoint"
ppSlide.Shapes(2).TextFrame.TextRange = "Author"

Set ppSlide = ppPres.Slides.Add(2, ppLayoutCustom)

ppSlide.Shapes(1).TextFrame.TextRange = "Manager Name"

Set tbox1 = ppSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 125, 75, 50)
tbox1.TextFrame.TextRange.Text = "Dept 1"
tbox1.TextFrame.TextRange.Font.Bold = msoTrue
tbox1.Fill.ForeColor.RGB = RGB(255, 150, 0)

Set tbox2 = ppSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 125, 75, 50)
tbox2.TextFrame.TextRange.Text = "Dept 2"
tbox2.TextFrame.TextRange.Font.Bold = msoTrue
tbox2.Fill.ForeColor.RGB = RGB(255, 150, 0)

Set tbox3 = ppSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 500, 125, 75, 50)
tbox3.TextFrame.TextRange.Text = "Dept 3"
tbox3.TextFrame.TextRange.Font.Bold = msoTrue
tbox3.Fill.ForeColor.RGB = RGB(255, 150, 0)

Set tbox1 = ppSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 700, 125, 80, 50)
tbox1.TextFrame.TextRange.Text = "Dept 4"
tbox1.TextFrame.TextRange.Font.Bold = msoTrue
tbox1.Fill.ForeColor.RGB = RGB(255, 150, 0)

Dim prerow As Integer
prerow = 3

Dim nextrow As Integer
Range("D3").Select

Dim SlideNo As Integer

SlideNo = 2
Do While True

Selection.End(xlDown).Select
If Selection.Value = "" Then

  Exit Do
  End If

nextrow = Selection.Row
Range("E" & prerow & ":E" & nextrow - 1).Select
    Selection.Copy

  ppPres.Slides(SlideNo).Shapes.Paste

   If Range("E" & nextrow).Offset(-1, 0) = "" Then
    SlideNo = SlideNo + 1
    nextrow = nextrow + 1
    End If

   prerow = nextrow
   Range("D" & prerow).Select

   Loop

   End Sub

1 个答案:

答案 0 :(得分:0)

很难理解你的代码实际实现的所有内容,而且我在测试时遇到了麻烦..但是关于主要问题:

  

粘贴后如何在幻灯片上定位列

您可以获取刚刚粘贴的形状的句柄并设置其.Top.Left属性。例如,粘贴列时,

ppPres.Slides(SlideNo).Shapes.Paste

你可以使用indtead

 With ppPres.Slides(SlideNo).Shapes.Paste
   .Top = tbox1.Top + tbox1.Width + 5
   .Left = tbox1.Left
 End With

这会在tbox1下放置一个粘贴的列...以这样的方式编写循环,使每个粘贴的列落在适当的位置。