如何遍历Sheets集合包含的Chart对象

ning84 · 发表于 2023-2-16 13:39

Sheets 对象 (Excel) | Microsoft Learn https://learn.microsoft.com/zh-cn/office/vba/api/excel.sheets

for each in Sheets
遍历不到Chart,只能遍历Sheet

Debug.Print Sheets("Chart6").Type --结果为3
Debug.Print Sheet1.Type --------结果为-4167

Dim Sht As Worksheet
For Each Sht In Worksheets
Debug.Print Sht.Name, Sht.Type
Next Sht

遍历结果sheet,type=-----====  -4167
Sheet1       -4167
Sheet2       -4167
Sheet3       -4167

************************************

Debug.Print Sheets("Chart6").Type------结果为3

lss001 · 发表于 2023-2-16 16:30

本帖最后由 lss001 于 2023-2-20 09:03 编辑

Sub 遍历表格与工作表区别()
For Each Sht In Sheets
'遍历表格＜工作表，图表，宏表，国际宏表，对话框表＞
Debug.Print Sht.Name, Sht.Type
Next

For Each Sh In Worksheets '工作表
Debug.Print Sh.Name, Sh.Type
Next

For Each Ch In Charts '图表
Debug.Print Ch.Name, Ch.Type
Next

For Each Mh In Excel4MacroSheets '宏表
Debug.Print Mh.Name, Mh.Type
Next

For Each MI In Excel4IntlMacroSheets '国际宏表
Debug.Print MI.Name, MI.Type
Next

For Each Dh In DialogSheets '对话框表
Debug.Print Dh.Name '无Type属性
Next
End Sub

ning84 · 发表于 2023-2-17 12:14

lss001 发表于 2023-2-16 16:30
Sub 遍历表格与工作表区别()
For Each Sht In Sheets
'遍历表格＜工作表，图表，宏表，对话框表＞

感谢帮助，谢谢举例。明白Sheets的集合的工作表有两种类型，Chart和Sheet。

Sheets 对象 (Excel)

项目
2023/02/15
6 个参与者

反馈

指定的或活动工作簿中所有工作表的集合。

注释

Sheets 集合可以包含 [color=var(--theme-visited)]Chart 或 [color=var(--theme-visited)]Worksheet 对象。

如果希望返回所有类型的工作表，Sheets 集合就非常有用。如果仅需使用某一类型的工作表，请参阅该工作表类型的对象主题。

Sub deldeldel()
Dim Sht As Worksheet
Dim XlsChart As Chart
Dim Shp As Shape
Dim oChart As ChartObject
Dim TxtFrm As TextFrame
For Each Sht In Application.Worksheets
Debug.Print Sht.Name; Sht.Type
Next Sht
For Each XlsChart In Application.Charts
Debug.Print XlsChart.Name, XlsChart.Type, XlsChart.Shapes.Count
Next XlsChart
Set XlsChart = Sheets("Chart6") 'ActiveSheet.ChartObjects("Chart6")
Debug.Print XlsChart.Name, XlsChart.Type, XlsChart.Shapes.Count
Debug.Print "-----------"
''
For Each Shp In XlsChart.Shapes
Debug.Print Shp.Name ', Shp.Typ
Set TxtFrm = Shp.TextFrame
'TxtFrm.AutoSize = True
TxtFrm.Characters.Text = Shp.Name & Int(Shp.Width) & " X " & Int(Shp.Height)
Select Case Shp.Type
Case 6
Case 7
Case 17
Set TxtFrm = Shp.TextFrame
TxtFrm.AutoSize = True
TxtFrm.Characters.Text = "文本框" & Int(Shp.Width) & " X " & Int(Shp.Height)
Debug.Print " ----", TxtFrm.Characters.Text
End Select
Next Shp
''
End Sub

复制代码

ning84 · 发表于 2023-2-17 18:49

MsoAutoShapeType 枚举 (Office) | Microsoft Learn https://learn.microsoft.com/zh-c ... ce.msoautoshapetype

名称值说明
msoShape10pointStar 149 10 磅星
msoShape12pointStar 150 12 磅星
msoShape16pointStar 94 16 磅星
msoShape24pointStar 95 24 磅星
msoShape32pointStar 96 32 磅星
msoShape4pointStar 91 4 磅星
msoShape5pointStar 92 5 磅星
msoShape6pointStar 147 6 磅星
msoShape7pointStar 148 7 磅星
msoShape8pointStar 93 8 磅星
msoShapeActionButtonBackorPrevious 129 “后退”或“上一个”按钮。支持鼠标单击和鼠标移过操作。
msoShapeActionButtonBeginning 131 “开始”按钮。支持鼠标单击和鼠标移过操作。
msoShapeActionButtonCustom 125 不带默认图片或文本的按钮。支持鼠标单击和鼠标移过操作。
msoShapeActionButtonDocument 134 “文档”按钮。支持鼠标单击和鼠标移过操作。
msoShapeActionButtonEnd 132 “结束”按钮。支持鼠标单击和鼠标移过操作。
msoShapeActionButtonForwardorNext 130 “前进”或“下一个”按钮。支持鼠标单击和鼠标移过操作。
msoShapeActionButtonHelp 127 帮助按钮。支持鼠标单击和鼠标移过操作。
msoShapeActionButtonHome 126 “主页”按钮。支持鼠标单击和鼠标移过操作。
msoShapeActionButtonInformation 128 “信息”按钮。支持鼠标单击和鼠标移过操作。
msoShapeActionButtonMovie 136 “影片”按钮。支持鼠标单击和鼠标移过操作。
msoShapeActionButtonReturn 133 “返回”按钮。支持鼠标单击和鼠标移过操作。
msoShapeActionButtonSound 135 “声音”按钮。支持鼠标单击和鼠标移过操作。
msoShapeArc 25 弧
msoShapeBalloon 137 气球
msoShapeBentArrow 41 带 90 度圆角的箭头。
msoShapeBentUpArrow 44 带 90 度直角的箭头。默认情况下上指。
msoShapeBevel 15 棱台效果
msoShapeBlockArc 20 块弧
msoShapeCan 13 可以
msoShapeChartPlus 182 正方形垂直和水平分为四个季度
msoShapeChartStar 181 正方形沿垂直线和对角线分为六个部分
msoShapeChartX 180 正方形沿对角线分为四部分
msoShapeChevron 52 雪佛龙
msoShapeChord 161 圆圈，用一条线连接两个点的外围通过圆的内部;带和弦的圆
msoShapeCircularArrow 60 曲线 180 度角后面的方块箭头
msoShapeCloud 179 云形状
msoShapeCloudCallout 108 云标注
msoShapeCorner 162 带矩形孔的矩形。
msoShapeCornerTabs 169 沿矩形路径对齐的四个右三角形;四个“被砍”的角落。
msoShapeCross 11 十字形
msoShapeCube 14 立方体
msoShapeCurvedDownArrow 48 向下弯曲的方块箭头
msoShapeCurvedDownRibbon 100 向下弯曲的功能区横幅
msoShapeCurvedLeftArrow 46 向左弯曲的方块箭头
msoShapeCurvedRightArrow 45 向右弯曲的方块箭头
msoShapeCurvedUpArrow 47 向上弯曲的方块箭头
msoShapeCurvedUpRibbon 99 向上弯曲的功能区横幅
msoShapeDecagon 144 Decagon
msoShapeDiagonalStripe 141 删除了两个三角形形状的矩形;对角线
msoShapeDiamond 4 菱形
msoShapeDodecagon 146 Dodecagon
msoShapeDonut 18 甜甜圈
msoShapeDoubleBrace 27 双大括号
msoShapeDoubleBracket 26 双括号
msoShapeDoubleWave 104 双波
msoShapeDownArrow 36 向下指向的块箭头
msoShapeDownArrowCallout 56 带有向下箭头的标注
msoShapeDownRibbon 98 功能区下中心区域位于功能区末端的功能区横幅
msoShapeExplosion1 89 Explosion
msoShapeExplosion2 90 Explosion
msoShapeFlowchartAlternateProcess 62 备用流程图符号
msoShapeFlowchartCard 75 卡片流程图符号
msoShapeFlowchartCollate 79 排序规则流程图符号
msoShapeFlowchartConnector 73 连接器流程图符号
msoShapeFlowchartData 64 数据流程图符号
msoShapeFlowchartDecision 63 决策流程图符号
msoShapeFlowchartDelay 84 延迟流程图符号
msoShapeFlowchartDirectAccessStorage 87 直接访问存储流程图符号
msoShapeFlowchartDisplay 88 显示流程图符号
msoShapeFlowchartDocument 67 文档流程图符号
msoShapeFlowchartExtract 81 提取流程图符号
msoShapeFlowchartInternalStorage 66 内部存储流程图符号
msoShapeFlowchartMagneticDisk 86 磁盘流程图符号
msoShapeFlowchartManualInput 71 手动输入流程图符号
msoShapeFlowchartManualOperation 72 手动操作流程图符号
msoShapeFlowchartMerge 82 合并流程图符号
msoShapeFlowchartMultidocument 68 多文档流程图符号
msoShapeFlowchartOfflineStorage 139 脱机存储流程图符号
msoShapeFlowchartOffpageConnector 74 页外连接器流程图符号
msoShapeFlowchartOr 78 “Or”流程图符号
msoShapeFlowchartPredefinedProcess 65 预定义流程图符号
msoShapeFlowchartPreparation 70 准备流程图符号
msoShapeFlowchartProcess 61 流程图符号
msoShapeFlowchartPunchedTape 76 打孔磁带流程图符号
msoShapeFlowchartSequentialAccessStorage 85 顺序访问存储流程图符号
msoShapeFlowchartSort 80 排序流程图符号
msoShapeFlowchartStoredData 83 存储的数据流程图符号
msoShapeFlowchartSummingJunction 77 求和交汇点流程图符号
msoShapeFlowchartTerminator 69 终止符流程图符号
msoShapeFoldedCorner 16 折叠角
msoShapeFrame 158 矩形相框
msoShapeFunnel 174 漏斗
msoShapeGear6 172 带六颗牙齿的齿轮
msoShapeGear9 173 带九颗牙齿的齿轮
msoShapeHalfFrame 159 矩形相框的一半
msoShapeHeart 21 心
msoShapeHeptagon 145 Heptagon
msoShapeHexagon 10 六角
msoShapeHorizontalScroll 102 水平滚动
msoShapeIsoscelesTriangle 7 等腰三角形
msoShapeLeftArrow 34 向左指向的块箭头
msoShapeLeftArrowCallout 54 带有向左箭头的标注
msoShapeLeftBrace 31 左大括号
msoShapeLeftBracket 29 左括号
msoShapeLeftCircularArrow 176 指向逆时针的圆形箭头
msoShapeLeftRightArrow 37 带向左和向右箭头的块箭头
msoShapeLeftRightArrowCallout 57 带有向左和向右箭头的标注
msoShapeLeftRightCircularArrow 177 指向顺时针和逆时针的圆形箭头;两端有点的曲线箭头
msoShapeLeftRightRibbon 140 两端都有箭头的功能区
msoShapeLeftRightUpArrow 40 带向左、向右和向上的箭头的块箭头
msoShapeLeftUpArrow 43 带向左和向上箭头的块箭头
msoShapeLightningBolt 22 闪电
msoShapeLineCallout1 109 带边框和水平标注线的标注
msoShapeLineCallout1AccentBar 113 带水平强调线的标注
msoShapeLineCallout1BorderandAccentBar 121 带边框和水平强调线的标注
msoShapeLineCallout1NoBorder 117 带水平线的标注
msoShapeLineCallout2 110 带对角线直线的标注
msoShapeLineCallout2AccentBar 114 带对角线标注线和强调线的标注
msoShapeLineCallout2BorderandAccentBar 122 带有边框、对角线和强调线的标注
msoShapeLineCallout2NoBorder 118 无边框和对角标注线的标注
msoShapeLineCallout3 111 带角度线的标注
msoShapeLineCallout3AccentBar 115 带角度标注线和强调线的标注
msoShapeLineCallout3BorderandAccentBar 123 带边框、角度标注线和强调线的标注
msoShapeLineCallout3NoBorder 119 无边框和带角度标注线的标注
msoShapeLineCallout4 112 带有形成 U 形的标注线段的标注
msoShapeLineCallout4AccentBar 116 带有强调线和标注线段的标注，形成 U 形
msoShapeLineCallout4BorderandAccentBar 124 带有构成 U 形的边框、强调线和标注线段的标注
msoShapeLineCallout4NoBorder 120 没有边框的标注和形成 U 形的标注线段
msoShapeLineInverse 183 行反
msoShapeMathDivide 166 除法符号 ÷
msoShapeMathEqual 167 等效符号 =
msoShapeMathMinus 164 减法符号 -
msoShapeMathMultiply 165 乘法符号 x
msoShapeMathNotEqual 168 非等效符号 ≠
msoShapeMathPlus 163 加法符号 +
msoShapeMixed -2 只返回值，表示其他状态的组合。
msoShapeMoon 24 月亮
msoShapeNonIsoscelesTrapezoid 143 具有非对称非并行侧的梯形
msoShapeNoSymbol 19 “No”符号
msoShapeNotchedRightArrow 50 向右指向的凹槽块箭头
msoShapeNotPrimitive 138 不支持
msoShapeOctagon 6 八角形
msoShapeOval 9 椭圆形
msoShapeOvalCallout 107 椭圆形标注
msoShapeParallelogram 2 平行四边形
msoShapePentagon 51 五角大楼
msoShapePie 142 缺少部分的圆形 (“pie”)
msoShapePieWedge 175 圆形的四分之一
msoShapePlaque 28 斑块
msoShapePlaqueTabs 171 定义矩形形状的四个四分之一圆
msoShapeQuadArrow 39 指向向上、向下、向左和向右的块箭头
msoShapeQuadArrowCallout 59 带有指向向上、向下、向左和向右的箭头的标注
msoShapeRectangle 1 矩形
msoShapeRectangularCallout 105 矩形标注
msoShapeRegularPentagon 12 五角大楼
msoShapeRightArrow 33 向右指向的方块箭头
msoShapeRightArrowCallout 53 带有向右箭头的标注
msoShapeRightBrace 32 右大括号
msoShapeRightBracket 30 右括号
msoShapeRightTriangle 8 右三角形
msoShapeRound1Rectangle 151 带一个圆角的矩形
msoShapeRound2DiagRectangle 157 具有两个圆角的矩形，对角线对角
msoShapeRound2SameRectangle 152 具有共享一侧的两个圆角的矩形
msoShapeRoundedRectangle 5 圆角矩形
msoShapeRoundedRectangularCallout 106 圆角矩形标注
msoShapeSmileyFace 17 笑脸
msoShapeSnip1Rectangle 155 具有一个夹角的矩形
msoShapeSnip2DiagRectangle 157 具有两个斜角的矩形，对角线对角
msoShapeSnip2SameRectangle 156 具有共享一侧的两个夹角的矩形
msoShapeSnipRoundRectangle 154 具有一个剪切角和一个圆角的矩形
msoShapeSquareTabs 170 定义矩形形状的四个小正方形
msoShapeStripedRightArrow 49 向右指的方块箭头，尾部有条纹
msoShapeSun 23 太阳
msoShapeSwooshArrow 178 曲线箭头
msoShapeTear 160 水滴
msoShapeTrapezoid 3 梯形
msoShapeUpArrow 35 向上指向的块箭头
msoShapeUpArrowCallout 55 带向上箭头的标注
msoShapeUpDownArrow 38 向上和向下指向的块箭头
msoShapeUpDownArrowCallout 58 带有向上和向下箭头的标注
msoShapeUpRibbon 97 功能区两端中心区域上方的功能区横幅
msoShapeUTurnArrow 42 形成 U 形状的块箭头
msoShapeVerticalScroll 101 垂直滚动
msoShapeWave 103 Wave

ning84 · 发表于 2023-3-28 13:30

''
Sub ll2()
Dim Pres As Presentation
Dim Sld As Slide, ShpRng As ShapeRange
Dim Arr1, Arr2
Dim xChart As Chart
Dim oTab As Table
Dim Txt As TextFrame
Dim TxtRng As TextRange
Dim Ww As Workbook
Dim Nn, Str
''
Dim Sht As Worksheet
Dim Rng As Range
Dim ii, jj
Dim Arr(7)
Set Pres = Application.ActivePresentation
Set Sld = Pres.Slides(1)
Set xChart = Sld.Shapes("C1").Chart
Set oTab = Sld.Shapes("T1").Table
Set Txt = Sld.Shapes("N1").TextFrame
Set TxtRng = Txt.TextRange
''
With xChart
For ii = .SeriesCollection.Count To 1 Step -1
.SeriesCollection(ii).Delete
Next ii
.ChartData.Activate
'Stop
Set Sht = .ChartData.Workbook.Worksheets(1)
Set Rng = Sht.Range("a1:i4")
.SetSourceData "=" & Sht.Name & "!" & Rng.Address, xlRows
.HasDataTable = True
.HasLegend = False
'.DataTable.Font.Size = 10
'.Axes(xlValue).Select
'ActiveWindow.Selection.TextRange.Font.Size = 9
'Selection.TickLabels.Font.Size = 10
'.Axes(xlValue, xlSecondary).Select
'Selection.TickLabels.Font.Size = 10
For ii = 1 To 3
Select Case ii
Case 1, 2
.SeriesCollection(ii).ChartType = xlColumnClustered 'xlColumnStacked
Case 3, 4
.SeriesCollection(ii).ChartType = xlLine
.SeriesCollection(ii).AxisGroup = 2
End Select
Next ii
'
With oTab
For ii = 1 To 3
Select Case ii
Case 2, 3
'.Cell(ii, 1).Shape.TextFrame2.TextRange.Text = Sht.Cells(ii, 1) & "时间差"
Case 5, 4
'.Cell(ii, 1).Shape.TextFrame2.TextRange.Text = Sht.Cells(ii, 1) & "温度差"
End Select
.Rows(ii).Height = 25
Next ii
For jj = 3 To 9
.Cell(1, jj - 2).Shape.TextFrame2.TextRange.Text = Sht.Cells(1, jj) & "-" & Sht.Cells(1, 2)
Next jj
''
For ii = 2 To 5
For jj = 3 To 9
'Nn = Sht.Cells(ii, jj) - Sht.Cells(ii, 2)
'Str = Format(Abs(Nn), "h""时""m""分"";@")
Str = Format(Abs(Sht.Cells(ii, jj) - Sht.Cells(ii, 2)), "h:m")
Nn = Split(Str, ":")
Str = Nn(0) * 60 + Nn(1) & "分"
Select Case ii
Case 2, 3
'.Cell(ii, jj - 2).Shape.TextFrame2.TextRange.Text = Format(Sht.Cells(ii, jj), "h:mm") & "-" & Format(Sht.Cells(ii, 2), "h:mm") & _
"=" & vbCr & Sht.Cells(ii, 1) & "时差" & Format(Abs(Nn), "h:mm")
.Cell(ii, jj - 2).Shape.TextFrame2.TextRange.Text = Sht.Cells(ii, 1) & "时差" & Str & _
vbCr & "(" & Format(Sht.Cells(ii, jj), "h:mm") & "-" & Format(Sht.Cells(ii, 2), "h:mm") & "=" & Format(Abs(Sht.Cells(ii, jj) - Sht.Cells(ii, 2)), "h:mm") & ")"
'Str = .Cell(ii, jj - 2).Shape.TextFrame2.TextRange.Characters(5, 4)
With .Cell(ii, jj - 2).Shape.TextFrame.TextRange.Characters(5, 4)
.Font.Color = -16776961
.Font.Size = 20
End With
'Debug.Print Str
Case 5, 4
'.Cell(ii, jj - 2).Shape.TextFrame2.TextRange.Text = Sht.Cells(ii, jj) & "-" & Sht.Cells(ii, 2) & _
"=" & Sht.Cells(ii, 1) & "温差" & Nn & "C"
'.Cell(ii, jj - 2).Shape.TextFrame2.TextRange.Text = Sht.Cells(ii, 1) & "温差" & Sht.Cells(ii, jj) - Sht.Cells(ii, 2) & "℃"
End Select
Next jj
Next ii
End With
End With
For ii = 16 To 24
Str = Sht.Cells(ii, 1)
Set Shp = Sld.Shapes(Str)
Set TxtRng2 = Shp.TextFrame2.TextRange
TxtRng2.Text = Sht.Cells(ii, 2)
Debug.Print Shp.Name, Shp.Type, TxtRng2.Text
Next ii
End Sub
''
Sub ll3()
Dim Pres As Presentation
Dim xChart As Chart
Dim xlWk As Workbook
Dim Sht As Worksheet
Dim Rng As Range
Dim Str
Set Pres = Application.ActivePresentation
Set xChart = Pres.Slides(1).Shapes("C1").Chart
''
xChart.ChartData.Activate
Set xlWk = xChart.ChartData.Workbook
Set Sht = xlWk.Worksheets(1)
Set Rng = Sht.Range("B1:I4")
Dim Shp As Shape, Kk
Dim Sld As Slide, oSld As Slide
Dim SldArr() As Slide
ReDim SldArr(1 To Rng.Columns.Count) As Slide
Dim ShpRng As ShapeRange
Dim TxtRng As TextRange
Set Sld = Pres.Slides(1)
''
For ii = 16 To 24
Str = Sht.Cells(ii, 1)
Set Shp = Sld.Shapes(Str)
Set TxtRng = Shp.TextFrame.TextRange
With TxtRng
.Text = Sht.Cells(ii, 2)
.Font.Color = -16776961
.Characters(Sht.Cells(ii, 3), Sht.Cells(ii, 4)).Font.Color = 0
End With
Next ii
''
For ii = Pres.Slides.Count To 2 Step -1
Set oSld = Pres.Slides(ii)
oSld.Delete
Next ii
For jj = 2 To Rng.Columns.Count
Sld.Duplicate
Next jj
For jj = 1 To Rng.Columns.Count
Set SldArr(jj) = Pres.Slides(jj)
SldArr(jj).Name = Rng(1, jj).Value
Next jj
ChangeChartNoteData Rng, SldArr
xlWk.Close
End Sub
Function ChangeChartNoteData(Rng As Range, SldArr)
Dim ii, jj
Dim oRng As Range
Dim Sld As Slide
For jj = 2 To Rng.Columns.Count
Set Sld = SldArr(jj)
ExchangeRng Sld, Rng, jj
Next jj
End Function
Function ExchangeRng(Sld As Slide, Rng As Range, Cc)
Dim ii, jj, Ccc, Str
Dim xChart As Chart
Dim Sht As Worksheet
Dim tmpRng As Range
Dim oRng As Range
Dim xlWk As Workbook
Dim TxtRng As TextRange
Set xChart = Sld.Shapes("C1").Chart ''
xChart.ChartData.Activate
Set xlWk = xChart.ChartData.Workbook
Set Sht = xlWk.Worksheets(1)
Set oRng = Sht.Range("B1:I4")
For jj = Cc To Rng.Columns.Count
For ii = 1 To Rng.Rows.Count
Ccc = jj - Cc + 1
oRng(ii, Ccc) = Rng(ii, jj)
Next ii
Next jj
''
For jj = 1 To Cc - 1
For ii = 1 To Rng.Rows.Count
Debug.Print oRng(ii, Ccc + jj).Address, Rng(ii, jj).Address
oRng(ii, jj + Ccc) = Rng(ii, jj)
Next ii
Next jj
For ii = 16 To 24
Str = Sht.Cells(ii, 1)
Set Shp = Sld.Shapes(Str)
Set TxtRng = Shp.TextFrame.TextRange
With TxtRng
.Text = Sht.Cells(ii, 2)
.Font.Color = -16776961
.Characters(Sht.Cells(ii, 3), Sht.Cells(ii, 4)).Font.Color = 0
End With
Next ii
''
xChart.ChartData.BreakLink
xlWk.Close
End Function

复制代码

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

如何遍历Sheets集合包含的Chart对象

评分