楼主
wise |
用VBA创建一个三维的按钮
具体代码如下：
- Sub Makebutton()
- Dim shp As Shape
- On Error Resume Next
- With ActiveSheet
- .Shapes("简单基本按钮").Delete
- .Shapes("简单按钮文本").Delete
- End With
- On Error GoTo 100
- param = Split(InputBox("输入" & vbCr & "高度, 左边, 按钮名称 , 模块名称", "简单按钮", "30, 30, 简单按钮, GetOk"), ",")
- Create_Easy_Button CInt(param(0)), CInt(param(1)), Trim(param(2)), Trim(param(3))
- 100:
- End Sub
- Sub Create_Easy_Button(x As Integer, Y As Integer, sText As String, sMacro As String)
- Dim Wdth As Long
- Dim Ht As Long
- Wdth = Len(sText) * 9
- If Len(sText) < 5 Then
- Ht = Wdth
- Else
- Ht = Wdth * (50 - Len(sText)) / 100
- End If
- With ActiveSheet.Shapes.AddShape(msoShapeRectangle, x, Y, Wdth, Ht) '添加形状类型,设置形状的属性
- .Name = "简单基本按钮"
- .Fill.ForeColor.RGB = RGB(200, 0, 0) '填充颜色
- .Placement = xlFreeFloating
- .OnAction = "触发GetOk" '每当单击形状时,运行GetOk 过程
- With .Line
- .ForeColor.RGB = RGB(255, 255, 255)
- .Weight = 3
- End With
- With .Shadow '显示阴影
- .Visible = True
- .OffsetX = 2
- .OffsetY = 2
- .Transparency = 0.5
- .ForeColor.RGB = RGB(10, 10, 10)
- End With
- With .ThreeD '显示3D形式
- .BevelTopType = 3
- .BevelTopDepth = 20
- .BevelTopInset = 19
- .ContourWidth = 0
- .Depth = 2
- .ExtrusionColorType = 1
- .FieldOfView = 45
- .LightAngle = 300
- .Perspective = 0
- .PresetLighting = 15
- .PresetMaterial = 6
- End With
- End With
- With ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, x - 1, (Y + Ht / 2) - 18, Wdth, 35)
- .Name = "简单按钮文本"
- With .TextFrame '添加文本，然后设置文本框架的边距
- .MarginBottom = 0
- .MarginLeft = 0
- .MarginRight = 0
- .MarginTop = 0
- .HorizontalAlignment = xlHAlignCenter
- .VerticalAlignment = xlVAlignCenter
- .Characters.Text = sText
- With .Characters.Font '设置文本字体属性
- .Bold = True
- .Size = 10
- .Name = "Calibri"
- .Color = RGB(255, 255, 255)
- .Shadow = True
- End With
- End With
- .Line.Visible = False
- .Fill.Visible = False
- .TextEffect.PresetTextEffect = 2
- .Placement = xlFreeFloating
- .OnAction = sMacro
- End With
- End Sub
- Sub GetOk()
- MsgBox "按钮已经插入！"
- End Sub
 简单按钮.rar
|