用于格式化从Excel复制到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

---

很难完全理解您的代码实际上实现了什么，我在测试它时遇到了困难。。但关于主要问题：

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

您可以获取刚刚粘贴的形状的控制柄，并设置其

.Top

和

.Left

属性。例如，粘贴列时

你可以用indtead

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

这将在

tbox1

下放置一个粘贴的列。。。以这样的方式编写循环：每个粘贴的列都落在适当的位置

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