更改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