利用VBA批量替换PPT中图例的文字内容

zhoujieses · 发表于 2020-3-5 11:07

批量将PPT中图表的文字内容进行替换，自带的查找替换只能替换正文内容

zhoujieses · 发表于 2020-3-5 11:26

有大神不？求教

zhoujieses · 发表于 2020-3-5 11:27

@weiyingde，老师，求教

zhoujieses · 发表于 2020-3-11 13:17

Sub ReplaceText()
Dim oSld As Slide
Dim oShp As Shape
Dim oTxtRng As TextRange
Dim oTmpRng As TextRange
Set oSld = Application.ActivePresentation.Slides(1)
For Each oShp In oSld.Shapes
Set oTxtRng = oShp.TextFrame.TextRange
      Set oTmpRng = oTxtRng.Replace(FindWhat:="华东", _
         Replacewhat:="huadong", WholeWords:=True)
      Do While Not oTmpRng Is Nothing
         Set oTxtRng = oTxtRng.Characters(oTmpRng.Start + oTmpRng.Length, _
            oTxtRng.Length)
         Set oTmpRng = oTxtRng.Replace(FindWhat:="华东", _
            Replacewhat:="huadong", WholeWords:=True)
      Loop
Next oShp
End Sub
这个运行没实现

zhoujieses · 发表于 2020-3-11 13:19

这是样本

lss001 · 发表于 2020-3-18 12:50

本帖最后由 lss001 于 2020-3-18 12:57 编辑

Sub ReplaceText()
Dim Sd As Slide, Wk As Object, Rng, Rp
Set Sd = ActivePresentation.Slides(1)
'图形中的工作簿对象
Set Wk = Sd.Shapes(3).Chart.ChartData.Workbook
'工作簿中的工作表数据范围
Set Rng = Wk.WorkSheets(1).Range("A1:N3")
'执行替换操作
Rp = Rng.Replace("北方", "BeiFang", 1)
End Sub

补充内容 (2023-2-7 15:13):
Set wk = Sd.Shapes(3).Chart.ChartData.Workbook
应改为→Set wk = Sd.Shapes(3).OLEFormat.Object

ning84 · 发表于 2023-1-23 08:24

Sub del()
Dim AddArr, WeathArray, Cc
AddArr = Array("兰州", "珠海", "武汉", "北京", "抚远", "漠河", "三沙", "喀什")
WeathArray = Array("日出", "日落", "天亮", "天黑", "最高气温", "最低气温", "天气")
Dim oPresent As Presentation
Dim Sld As Slide
Dim ShpRng As ShapeRange
Dim Shp As Shape
Dim GrpChart 'As Graph.Chart
Set oPresent = Application.ActivePresentation
With oPresent
For Each Sld In .Slides
Sld.Delete
Next Sld
Stop
For ii = 0 To UBound(WeathArray)
Set Sld = .Slides.Add(Index:=2, Layout:=ppLayoutBlank)
'Sld.Name = WeathArray(ii)
Set GrpChart = Sld.Shapes.AddOLEObject(Left:=120, Top:=110, Width:=480, Height:=320, ClassName:="MSGraph.Chart", Link:=msoFalse)
Debug.Print GrpChart.Name
Next ii
''
For Each Sld In .Slides
Debug.Print Sld.Name
Next Sld
End With
End Sub

复制代码

还是遇到定义问题。

ning84 · 发表于 2023-5-2 08:45

Sub ll()
Dim Pres As Presentation
Dim Sld As Slide
Dim Shp As Shape
Set Pres = Application.ActivePresentation
For Each Sld In Pres.Slides
For ii = 1 To Sld.Shapes.Count
Set Shp = Sld.Shapes(ii)
With Shp
Debug.Print Shp.Name, .Left, .Top, .Width, .Height,
End With
Next ii
Debug.Print
Next Sld
End Sub

复制代码

		自动登录	找回密码
密码			免费注册

[求助] 利用VBA批量替换PPT中图例的文字内容