MsoAutoShapeType，字符串不成立，Emnu类型成立。

ning84 · 发表于 2024-9-10 01:51

MsoAutoShapeType 枚举 (Office) | Microsoft Learn  https://learn.microsoft.com/zh-cn/office/vba/api/office.msoautoshapetype

msoShapeActionButtonDocument       134       “文档”按钮。支持鼠标单击和鼠标移过操作。
msoShapeActionButtonEnd       132       “结束”按钮。支持鼠标单击和鼠标移过操作。
msoShapeActionButtonForwardorNext       130       “前进”或“下一个”按钮。支持鼠标单击和鼠标移过操作。
msoShapeActionButtonHelp       127       帮助按钮。支持鼠标单击和鼠标移过操作。
msoShapeActionButtonHome       126       “主页”按钮。支持鼠标单击和鼠标移过操作。
msoShapeActionButtonInformation       128       “信息”按钮。支持鼠标单击和鼠标移过操作。

用枚举emnu成立， ShpType = msoShapeActionButtonHelp
用字符型不成立 ShpType = "msoShapeActionButtonHelp"

Sub ddddd()
Dim ShpType As MsoAutoShapeType
ShpType = msoShapeActionButtonHelp
ShpType = "msoShapeActionButtonHelp"
Dim ShpRng As ShapeRange
Set ShpRng = Application.ActiveWindow.Selection.ShapeRange
With ShpRng
.AutoShapeType = ShpType
Debug.Print .AutoShapeType
Stop
End With
End Sub

复制代码

数组循环方法

Sub ConvertStringToEnum()
Dim strShape As String
strShape = "msoShape10pointStar"
Dim shapeType As MsoAutoShapeType
Dim enumValue As Variant
For Each enumValue In Array(msoShape10pointStar, msoShape16pointStar, msoShape24pointStar)
      If CStr(enumValue) = strShape Then
         shapeType = enumValue
         Exit For
      End If
Next enumValue
End Sub

******************************
使用Application.Evaluate 方法不成立

Sub ConvertShapeString()
Dim shapeString As String
shapeString = "msoShape10pointStar"
shapeString = "msoShapeActionButtonHelp"
Dim shapeType As MsoAutoShapeType
'Evaluate "shapeType = " & shapeString
Application.Evaluate "shapeType = " & shapeString
Stop
Dim ShpRng As ShapeRange
Set ShpRng = Application.ActiveWindow.Selection.ShapeRange
With ShpRng
.AutoShapeType = shapeType
Debug.Print .AutoShapeType
Stop
End With
Stop
End Sub

复制代码

taller · 发表于 2024-9-10 09:50

ww87725244 · 发表于 2024-9-10 10:19

VBA的枚举是Emnu吗？
C#是enum

ning84 · 发表于 2024-9-11 22:41

学习学再学习。

Function AddLable(Shps, Rng As Range)
Dim Sht As Worksheet
Dim S As Shape
Dim msoShape As MsoAutoShapeType
Dim Str
Dim Cc As Integer, Ll, Tt, Ww, Hh, fSize
Cc = 1
Ll = Rng(, Cc + 1)
Tt = Rng(, Cc + 2)
Ww = Rng(, Cc + 3)
Hh = Rng(, Cc + 4)
fSize = Rng(, Cc + 5)
Dim Shp ', Shps, s As Shape, Ss As Shapes
Dim TxtRng 'As TextRange2
'''
For ii = 1 To Rng.Rows.Count
Set Shp = Shps.AddLabel(msoTextOrientationHorizontal, Ll, Tt, Ww, Hh)
With Shp
.Name = "Txt" & ii
'.TextEffect.Text = Rng(ii, Cc)
Str = Rng(ii, Cc)
.TextFrame2.TextRange.text = Str
''
nn = Len(Rng(ii, "W"))
''
Set TxtRng = .TextFrame.TextRange
TxtRng.Select
''
TxtRng.Characters(1, nn + 1).Font.Size = fSize
TxtRng.Characters(nn + 1, Len(Str) - nn + 2).Font.Size = fSize * 0.8
'Debug.Print Rng(, Cc + 6).Address, Rng(, Cc + 6)
msoShape = Rng(, Cc + 6)
.AutoShapeType = msoShape
.Line.Visible = True
'.TextEffect.FontSize = Rng(, Cc + 7)
End With
Next ii
End Function
Sub RngToSldTextbox()
Dim Ppt As New PowerPoint.Application
Set Ppt = New PowerPoint.Application
Dim Rng As Range
Set Rng = Selection
Dim Sht As Worksheet
Set Sht = Rng.Parent
Dim Pres As Presentation
Dim Sld As Slide
Dim ShpRng, Shp
Dim SldRng 'As SlideRange
Set SldRng = Ppt.ActiveWindow.Selection.SlideRange
Set Shps = SldRng.Shapes
For ii = Shps.Count To 1 Step -1
Set Shp = Shps(ii)
If Shp.Type = msoTextBox Then
Shp.Delete
End If
Next ii
'''
For ii = 1 To Rng.Rows.Count
AddLable Shps, Sht.Cells(Rng(ii, 1).Row, "A")
Next ii
End Sub

复制代码

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