按规范详细定义Dim，能降低PPT-VBA学习难度。

ning84 · 发表于 2023-1-26 14:46

Dim Ppt As Objct
Dim Pres As Objct
Dim Sld As Object
使用objct自学编程比较难。

按规范详细定义Dim，自学编程难度会降低。
Dim Ppt As PowerPoint.Application
Dim Pres As Presentation
Dim Sld As Slide

Sub ll1()
Dim Ppt As PowerPoint.Application
Dim Pres As Presentation
Dim Sld As Slide
Dim ShpRng As ShapeRange
Dim Shp As Shape
Dim GrpChart As Graph.Chart
Dim GrpSht As Graph.DataSheet
Set Ppt = New PowerPoint.Application
Set Pres = Ppt.ActivePresentation
Set ShpRng = Ppt.ActiveWindow.Selection.ShapeRange
Debug.Print ShpRng.Name
Set GrpChart = ShpRng.OLEFormat.Object
Debug.Print GrpChart.Name
Set GrpSht = GrpChart.Application.DataSheet
Debug.Print GrpChart.Application.Parent.Name
Debug.Print GrpChart.Application.Parent.Application.Parent.Name
Debug.Print ShpRng.Parent.Name
Set Sld = ShpRng.Parent
With Sld
.DisplayMasterShapes = msoTrue
With .Background
.Visible = msoTrue
.Fill.BackColor.RGB = RGB(200, 100, 20)
.Fill.Transparency = 0#
.Fill.Solid
End With
End With
Debug.Print Sld.Name
With GrpSht
.Cells.Clear
For ii = 2 To 5
.Cells(ii, 1) = "A" & ii - 1
For jj = 2 To 9
.Cells(1, jj) = "T" & jj - 1
.Cells(ii, jj) = Int(Rnd(10) * 100)
Next jj
Next ii
.Font.Size = 50
.Width = 3000
.Font.FontStyle = "黑体"
Debug.Print .Font.Size, .Font.FontStyle, .Height, .Width
Debug.Print .Cells.ColumnWidth
.Cells(1, 1).ColumnWidth = 10
Debug.Print .Cells.ColumnWidth
Debug.Print .Width, .Height
End With
With GrpChart
.HasDataTable = True
.HasLegend = False
.HasTitle = True
.ChartType = xlLineMarkersStacked
For ii = 1 To 4
With .SeriesCollection(ii).Border
Debug.Print .Weight
.Weight = 4 ' xlThick ' = xlThick
.ColorIndex = Rnd(10)
.LineStyle = xlContinuous
End With
.SeriesCollection(ii).MarkerSize = 8
Next ii
End With
End Sub

复制代码

Ppt-VBA没有宏录制,excel-VBA录制的程序，调试程序没通过。

            With .SeriesCollection(ii).Border
                  Debug.Print .Weight
                  .Weight = 4 ' xlThick ' = xlThick
                  .ColorIndex = Rnd(10)
                  .LineStyle = xlContinuous
            End With

LIUZHU · 发表于 2023-1-26 19:28

直接定义实例化对象，需要前期绑定类库，好处是写代码的时候，有提示

ning84 · 发表于 2023-1-26 22:17

绑定库后，按规范定义，提高编程效率。
如Dim oChart As Chart，按提示编程使用方便。
with oChart
............
end with

Sub dal()
Dim objChart As ChartObject
Dim oChart As Chart
For Each objChart In Sheet1.ChartObjects
Set oChart = objChart.Chart
With oChart
Debug.Print .SeriesCollection.Count
.ChartType = xlLineMarkers
'.ChartType = xlColumnStacked
.SeriesCollection(3).ChartType = xlColumnStacked
For ii = 1 To .SeriesCollection.Count
With .SeriesCollection(ii)
.Border.ColorIndex = ii * 10 ' Int(Rnd(10) * 10)
.Border.Weight = xlThick
.MarkerSize = 7
.Shadow = True
'.Select
End With
'Selection.MarkerBackgroundColorIndex = 54
'Selection.MarkerForegroundColorIndex = 10
Next ii
.HasDataTable = True
.HasLegend = False
.HasAxis(xlCategory, xlPrimary) = True
.HasAxis(xlValue, xlPrimary) = False
.SeriesCollection(1).XValues = "=Graph!R1C1:R1C5"
.SeriesCollection(1).Values = "=Graph!R2C1:R4C1"
.SeriesCollection(2).XValues = "=Graph!R1C1:R1C5"
.SeriesCollection(3).XValues = "=Graph!R1C1:R1C5"
End With
Next objChart
End Sub

复制代码

taller · 发表于 2023-1-27 00:24

ning84 · 发表于 2023-1-27 13:21

PowerPoint VBA编程手册-PowerPoint-ExcelHome技术论坛 - https://club.excelhome.net/threa ... =0.7896558404647378
VBA图表基础教程-Excel VBA程序开发-ExcelHome技术论坛 - https://club.excelhome.net/thread-1417686-1-1.html

Sub del()
Dim DateArr
DateArr = Array(0.344143518518518, 0.295590277777778, 0.305763888888889, 0.316655092592593, 0.28744212962963, 0.335081018518519, 0.301400462962963, 0.428032407407407, 0.751655092592593, 0.746076388888889, 0.731851851851852, 0.709282407407407, 0.639097222222222, 0.656782407407407, 0.762569444444444, 0.822488425925926)
Dim oChart As Chart
Dim objChart As ChartObject
Dim Sht As Worksheet
Dim Rng As Range
Dim Grp As Graph.Application
Dim GrpSht As DataSheet
Dim GrpChart As Graph.Chart
Dim Shp As Shape
Dim ShpRng As ShapeRange
Dim ii, jj, Ss, Hh
Arr = Array(-4098, 78, 79, 60, 61, 62, -4100, 54, 55, 56, -4101, -4102, 70, 1, 76, 77, 57, 71, 58, 59, 15, 87, 51, 52, 53, 102, 103, 104, 105, 99, 100, 101, 95, 96, 97, 98, 92, 93, 94, -4120, 80, 4, 65, 66)
Set Sht = Sheet2
For Each Shp In Sht.Shapes
'Debug.Print Shp.Name
Shp.Delete
Next Shp
For ii = 0 To 45 'UBound(Arr)
Set GrpChart = Sht.OLEObjects.Add(ClassType:="MSGraph.Chart.8", Link:=False, DisplayAsIcon:=False).Object
Set Shp = Sht.Shapes(Sht.Shapes.Count)
With Shp
'.Width = 1800
.Height = 300
If ii Mod 2 = 1 Then
.Left = 4
Hh = (ii + 1) * 160
ElseIf ii Mod 2 = 0 Then
.Left = 4 + 440
Hh = (ii - 0) * 160
End If
.Top = 4 + Hh
End With
''
With GrpChart
''
Set GrpSht = .Application.DataSheet
With GrpSht
For jj = 1 To 8
GrpSht.Cells(1, jj + 1) = "A" & jj
Next jj
''
For jj = 0 To 7
GrpSht.Cells(2, jj + 2) = Format(DateArr(jj), "hh:mm:ss")
GrpSht.Cells(3, jj + 2) = Format(DateArr(jj + 8), "hh:mm:ss")
Ss = DateArr(jj + 8) - DateArr(jj)
GrpSht.Cells(4, jj + 2) = Format(Ss, "hh:mm:ss")
Next jj
.Application.Chart.ChartType = Arr(ii) 'xlLineMarkersStacked ' Arr(9)(0)
End With
.HasDataTable = True
.HasLegend = False
.HasAxis(xlCategory, xlPrimary) = True
.HasAxis(xlValue, xlPrimary) = False
End With
Next ii
End Sub

复制代码

lss001 · 发表于 2023-2-1 15:27

本帖最后由 lss001 于 2023-2-4 23:35 编辑

Sub ExcelMSGraphChart8修改图表数据()
'创建图表时使用
Set Myole = ActiveSheet.Shapes.AddOLEObject( _
"MSGraph.Chart.8", , 1, , , , ,10,10,218,128)
'图表名称
Myole.Name = "myole"
'修改图表时使用
'Set Myole = ActiveSheet.Shapes("myole")
   '选中图表
   Myole.Select
'数据表对象
Set Mycha = Myole.OLEFormat.Object.Object
'数据表
Set Mysh = Mycha.Application.DataSheet
'修改数据表
For i = 2 To 4
   For j = 2 To 5
         Msh.Cells(i, j) = CStr(i + j)
   Next
Next
End Sub

blackttea1 · 发表于 2023-2-2 16:35

很感兴趣，谢谢

xkzb · 发表于 2023-2-2 17:47

很感兴趣，谢谢

ning84 · 发表于 2023-2-2 22:36

Ppt的一级套一级的关系" & vbCr & "把人搞的晕晕乎乎老出错

Sub del()
Dim DateArr
DateArr = Array(0.344143518518518, 0.295590277777778, 0.305763888888889, 0.316655092592593, 0.28744212962963, 0.335081018518519, 0.301400462962963, 0.428032407407407, 0.751655092592593, 0.746076388888889, 0.731851851851852, 0.709282407407407, 0.639097222222222, 0.656782407407407, 0.762569444444444, 0.822488425925926)
Dim oChart As Chart
Dim XlWk As Workbook
Dim Sht As Worksheet
Dim Rng As Range
Dim Grp As Graph.Application
Dim GrpSht As DataSheet
Dim GrpChart As Graph.Chart
Dim ii, jj, Ss, Hh
Dim Pres As Presentation
Dim Sld As Slide
Dim Shp 'As Shape
Dim ShpRng As ShapeRange
Set Pres = Application.ActivePresentation
If Pres.Slides.Count >= 1 Then
For ii = Pres.Slides.Count To 1 Step -1
Set Sld = Pres.Slides(ii)
Sld.Delete
Next ii
End If
For Each Shp In Pres.Slides
'Shp.Delete
Next Shp
Stop
''
Arr = Array(-4098, 78, 79, 60, 61, 62, -4100, 54, 55, 56, -4101, -4102, 70, 1, 76, 77, 57, 71, 58, 59, 15, 87, 51, 52, 53, 102, 103, 104, 105, 99, 100, 101, 95, 96, 97, 98, 92, 93, 94, -4120, 80, 4, 65, 66)
''
For ii = 0 To 2 '44 'UBound(Arr)
Set Sld = Pres.Slides.Add(ii + 1, ppLayoutBlank)
Set Shp = Sld.Shapes.AddOLEObject(Left:=50, Top:=180, Width:=700, Height:=320, ClassName:="MSGraph.Chart", Link:=msoFalse)
''
Set GrpChart = Shp.OLEFormat.Object
Debug.Print GrpChart.Name
''
With GrpChart
''
Set GrpSht = .Application.DataSheet
With GrpSht
For jj = 1 To 8
GrpSht.Cells(1, jj + 1) = "A" & jj
Next jj
''
For jj = 0 To 7
GrpSht.Cells(2, jj + 2) = Format(DateArr(jj), "hh:mm:ss")
GrpSht.Cells(3, jj + 2) = Format(DateArr(jj + 8), "hh:mm:ss")
Ss = DateArr(jj + 8) - DateArr(jj)
GrpSht.Cells(4, jj + 2) = Format(Ss, "hh:mm:ss")
Next jj
.Application.Chart.ChartType = Arr(ii) 'xlLineMarkersStacked ' Arr(9)(0)
End With
.HasDataTable = True
.HasLegend = False
.HasTitle = True
.HasAxis(xlCategory, xlPrimary) = True
.HasAxis(xlValue, xlPrimary) = False
.ChartTitle.Text = "Ppt的一级套一级的关系" & vbCr & "把人搞的晕晕乎乎老出错"
End With
Next ii
End Sub

复制代码

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

[求助] 按规范详细定义Dim，能降低PPT-VBA学习难度。

评分