首页
学习
活动
专区
圈层
工具
发布
社区首页 >问答首页 >在PowerPoint中更改表中特定值的颜色

在PowerPoint中更改表中特定值的颜色
EN

Stack Overflow用户
提问于 2015-11-04 16:06:43
回答 1查看 849关注 0票数 0

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

代码语言:javascript
复制
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
EN

Stack Overflow用户

发布于 2015-11-04 16:24:11

试试这个:

代码语言:javascript
复制
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
票数 0
EN
查看全部 1 条回答
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/33516654

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档