|
こんな方法もありますけど...。(とりあえず3色)
手順をうまく説明できそうにないので、手順の段階をマクロで書きました。(前に書いておいた物)
別ブックをアクティブにして実行してみてください。(シートが3枚あること)
新規ブックで実行したあとマクロを消してもいいです。
(もう1個のスレッドは長そうなのでこちらに..。)
Sub maru()
'3枚目のシート名を変更)
Sheets(3).Name = "画像シート"
Sheets("画像シート").Activate
ActiveWindow.Zoom = 200
Columns(1).ColumnWidth = 4
Columns(2).ColumnWidth = 2
Rows("1:5").RowHeight = 15.75
Range("A1").Value = "名前"
Range("A2:A4").Value = Application.Transpose(Array("赤", "黄", "青"))
Range("B1").Value = "図形"
RL = Range("B2").Left + 0.5
HH = Range("B2").Height - 1
TP = Range("B2").Top + 1
WD = Range("B2").Width - 0.5
ActiveSheet.Shapes.AddShape(msoShapeOval, RL, TP, WD, HH).Select
'Selection.ShapeRange.Fill.Visible = msoFalse '透明
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10 '赤
Selection.ShapeRange.Fill.Transparency = 0.5
RL = Range("B3").Left + 0.5
HH = Range("B3").Height - 1
TP = Range("B3").Top + 1
WD = Range("B3").Width - 0.5
ActiveSheet.Shapes.AddShape(msoShapeOval, RL, TP, WD, HH).Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 13 '黄色
Selection.ShapeRange.Fill.Transparency = 0.5
RL = Range("B4").Left + 0.5
HH = Range("B4").Height - 1
TP = Range("B4").Top + 1
WD = Range("B4").Width - 0.5
ActiveSheet.Shapes.AddShape(msoShapeOval, RL, TP, WD, HH).Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 40 'アクアブルー
Selection.ShapeRange.Fill.Transparency = 0.5
Range("B1").Select
ActiveWorkbook.Names.Add Name:="画像", RefersTo:= _
"=INDEX(画像シート!$A$1:$B$5,MATCH(Sheet1!A1,画像シート!$A$1:$A$5,0),2)"
Sheets("Sheet1").Activate
ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
, DisplayAsIcon:=False, Left:=80, Top:=35, Width:=20, Height:=20).Select
ExecuteExcel4Macro "FORMULA(""=画像"")"
DoEvents
Range("B1").Select
With Sheets("Sheet1")
.Range("B1").Value = "←どれか選択してください。"
With .Range("A1")
.BorderAround (1)
With .Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="赤,黄,青"
End With
End With
End With
End Sub
。
|
|