| |
こんばんは。
図形でフォームのボタンもどきを作ると背景色も変更できますよ！！
新規ブックの標準モジュールに
'=================================================================
Sub main()
Dim btn As Shape
[c10].Select
Set btn = newbutton(ActiveSheet)
btn.OnAction = "test"
[f10].Select
Set btn = newbutton(ActiveSheet, "Button2", , , , , &H800000, &HFFFF00)
btn.OnAction = "test"
Set btn = Nothing
End Sub
'=================================================================
Function newbutton(ByVal sht As Worksheet, _
Optional ByVal txt As String = "", _
Optional ByVal left As Single = -1, _
Optional ByVal top As Single = -1, _
Optional ByVal width As Single = 72, _
Optional ByVal height As Single = 24, _
Optional ByVal folor As Long = &H80000012, _
Optional ByVal bcolor As Long = &HC0C0C0) As Shape
'sht 作成シート txt Caption文字列 left,top,width,heightは、ボタンの位置とサイズ
'fcolor 文字の色（RGB） bcolor ボタンの色(RGB)
If txt = "" Then txt = "button"
If left < 0 Then left = ActiveCell.left
If top < 0 Then top = ActiveCell.top
Set newbutton = sht.Shapes.AddShape(msoShapeRectangle, _
left, top, width, height)
With newbutton
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.RGB = bcolor
.Fill.Transparency = 0#
.Line.Visible = msoFalse
.Shadow.Type = msoShadow14
With .TextFrame
.Characters.Text = txt
.Characters.Font.color = folor
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlVAlignCenter
End With
End With
End Function
'=================================================================
Sub test()
MsgBox "ok"
End Sub
でmainを実行してみてください
セルＣ１０とＦ１０にボタンもどきの四角形（Rectangle）を作成します。
フォームのボタンに見えませんか？
|
|
ichinose
- 07/3/25(日) 20:17 -
