Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

39639 / 76732

←次へ　｜　前へ→


	【42202】Re:無理ですか条件付き書式は３個から５個に

Jaka - 06/9/4(月) 9:58 -


	引用なし

	パスワード

こんな方法もありますけど...。（とりあえず３色）
手順をうまく説明できそうにないので、手順の段階をマクロで書きました。（前に書いておいた物）
別ブックをアクティブにして実行してみてください。（シートが３枚あること）
新規ブックで実行したあとマクロを消してもいいです。
（もう１個のスレッドは長そうなのでこちらに..。）

Sub maru()
'３枚目のシート名を変更）
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
。

0 hits

▼

【42156】無理ですか条件付き書式は３個から５個に kazu 06/9/3(日) 0:16