Excel VBA質問箱 IV

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

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


39639 / 76732 ←次へ | 前へ→

【42202】Re:無理ですか条件付き書式は3個から5個に
発言  Jaka  - 06/9/4(月) 9:58 -

引用なし
パスワード
   こんな方法もありますけど...。(とりあえず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

2 hits

【42156】無理ですか条件付き書式は3個から5個に kazu 06/9/3(日) 0:16 質問
【42157】Re:無理ですか条件付き書式は3個から5... [名前なし] 06/9/3(日) 2:02 発言
【42168】Re:無理ですか条件付き書式は3個から5... kazu 06/9/3(日) 17:07 お礼
【42159】Re:無理ですか条件付き書式は3個から5個に りん 06/9/3(日) 9:02 回答
【42167】Re:無理ですか条件付き書式は3個から5個に kazu 06/9/3(日) 17:05 お礼
【42202】Re:無理ですか条件付き書式は3個から5個に Jaka 06/9/4(月) 9:58 発言
【42203】補足 Jaka 06/9/4(月) 10:00 発言

39639 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free