更改PowerPoint

Question

我在PowerPoint中有一个表，它是使用VBA从宏代码生成的。我想将负数的颜色更改为红色，将正数的颜色更改为绿色（需要更改颜色的值在第三列中）。生成表并将所有数字放入精确行和列的代码如下：

Sub RangeTransferToTable102()
 '
 ' Copy each data cell in Excel range to the PowerPoint Slide 46 Shape 102 Table
 '
 Dim pptApp As PowerPoint.Application
 Dim oPPTShape As PowerPoint.Shape
 Dim rng As Excel.Range
 Dim frmt As Variant
 '
 ' Set oPPP to PowerPoint by creating a new instance of PowerPoint.
 ' If PowerPoint is already open, you would instead use the GetObject
 ' method instead.
 '
 Set pptApp = GetObject(, "PowerPoint.Application")
 '
 ' Set PowerPoint to be Visible.
 '
pptApp.Visible = msoTrue
 pptApp.ActivePresentation.Slides("Slide310").Select
 pptApp.Activate
 Worksheets("Switch_CS").Activate
 Set rng = Range("GR2:GV11")

 For rw = 1 To 10
 For cl = 1 To 5
 Data = rng.Cells(rw, cl).Value

 If Not (IsEmpty(rng.Cells(rw, cl))) Then
 If IsNumeric(rng.Cells(rw, cl)) Then 'Convert numeric value to text using number format
 frmt = rng.Cells(rw, cl).NumberFormat
 Data = WorksheetFunction.Text(rng.Cells(rw, cl).Value, frmt)
 End If
 Else
 Data = rng.Cells(rw, cl).Value
 End If
 With pptApp.ActivePresentation.Slides("Slide310").Shapes("Table 102").table.cell(rw + 1, cl)
 .Shape.TextFrame.TextRange.Delete
 .Shape.TextFrame.TextRange.Text = Data
 End With
 Next cl
 Next rw

 End Sub

Answer 1

试试这个：

Sub RangeTransferToTable102()
 '
 ' Copy each data cell in Excel range to the PowerPoint Slide 46 Shape 102 Table
 '
 Dim pptApp As PowerPoint.Application
 Dim oPPTShape As PowerPoint.Shape
 Dim rng As Excel.Range
 Dim frmt As Variant
 '
 ' Set oPPP to PowerPoint by creating a new instance of PowerPoint.
 ' If PowerPoint is already open, you would instead use the GetObject
 ' method instead.
 '
 Set pptApp = GetObject(, "PowerPoint.Application")
 '
 ' Set PowerPoint to be Visible.
 '
 pptApp.Visible = msoTrue
 pptApp.ActivePresentation.Slides("Slide310").Select
 pptApp.Activate
 Worksheets("Switch_CS").Activate
 Set rng = Range("GR2:GV11")

 For rw = 1 To 10
 For cl = 1 To 5
 Data = rng.Cells(rw, cl).Value

 If Not (IsEmpty(rng.Cells(rw, cl))) Then
 If IsNumeric(rng.Cells(rw, cl)) Then 'Convert numeric value to text using number format

 If rng.Cells(rw, cl).value >= 0 Then
 rng.Cells(rw, cl).Font.Color = -11489280
 Else
 rng.Cells(rw, cl).Font.Color = -16776961
 End If

 frmt = rng.Cells(rw, cl).NumberFormat
 Data = WorksheetFunction.Text(rng.Cells(rw, cl).Value, frmt)
 End If
 Else
 Data = rng.Cells(rw, cl).Value
 End If
 With pptApp.ActivePresentation.Slides("Slide310").Shapes("Table 102").table.cell(rw + 1, cl)
 .Shape.TextFrame.TextRange.Delete
 .Shape.TextFrame.TextRange.Text = Data
 End With
 Next cl
 Next rw

 End Sub