[[20111126210215]]　『クリックすると現れる図形』（悠介）　ページの最後に飛ぶ

『クリックすると現れる図形』（悠介）

【質問内容】
エクセルの図形についての質問です。
図形自体にマクロを登録して、クリックすると消え、もう一度クリックすると
現れるようにしたいです。
（たとえば「　あり / なし　」選択の丸囲いのように）

調べましたがよくわかりませんでした。
よろしくお願いいたします。
（当方ごく簡単なマクロがわかる程度のスキルです。）

【Excel2010,Windows 7】

 クリックしたら消える
 ↓
 次に表示させたいときは「何を」クリックするのですか？
 消えたものはクリックできないし・・・。

 (シスボーベー)

言葉足らずですみません。
「消える」というのは見えなくするという意味で…
図形の枠線の色のクリアでもいいんです。
図形自体は見えなくなってもそこにあるので
クリックすれば再度見えるようになる、という感じです。
（悠介）

 シェイプの書式設定の「色と線」で「塗り潰し」の「透明」を100%にする作業をマクロの自動記録
 してみてください。

 参考になるコードが取れると思います。
 取れたコードを改造してIf文で条件分岐してやればお望みのことが出来ると思います。

 今日はもうネットを切りますのでレスできません。
 他の方のレスをお待ちになってください。

 レスするとなると明日の夜になると思います。

 ※見落としてました。
 >【Excel2010,Windows 7】 
 シェイプを扱うコードはマクロの自動記録で取れないかもしれません。
 環境が無いのでなんともいえないですが。

 (シスボーベー)

シスボーベー様
重ね重ねご返答ありがとうございます。
ただそこまで専門的なことになると自分ではわかりません…すみません。
大変恐縮なのですが、図形に設定するマクロのコードをお教えいただけました幸いです。
遅くなりましても結構ですのでお手数おかけいたしますがよろしくお願いいたします。
（悠介）

 2010は線の色変えるくらいなら自動記録とれます。
とりあえず記録してそのコードをここに挙げてみては？
（さくら）

【見えている図形を消す】
Sub Macro1()
'
' Macro1 Macro
'

    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .Transparency = 1
    End With
End Sub

【消えている図形を見せる】

Sub Macro2()
'
' Macro2 Macro
'

    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .Transparency = 0
    End With
End Sub

マクロの記録ではこうなりました。
ご教授よろしくお願いいたします。
（悠介）

 あとは、これを１つにまとめてIf文で分岐させればいいんだけど、
・シート上の図形にマクロ登録して、クリックされたらそのマクロに飛び込む、そのときに、その図形の名前が
　Application.Caller というものに納められている。
・図形(Shape）を選択して、それを With でうけると、実は、そのShapeではなく、その中にあるDrawingObjectという部分が
　Selection内に格納されている。一方、FillやLineの親は、Shape。なのでマクロ記録したコードでは
  With Selection.ShapeRange.Line というように、選択したShapeの中のDrawingObjectの親であるShapeRange と
 ちょっと、まだるっこしい記述になっている。
・提示のコードで、隠したり表示したりというところでは「透過度」が、その役割。RGBで指定する色は、本件操作には不要。

 といったことを加味すると、以下のプロシジャになるかな。これを図形にマクロ登録。

 Sub 図形を見せたり隠したり()
    With ActiveSheet.Shapes(Application.Caller)
        If .Line.Transparency = 1 Then '透過度100%（隠れている状態）なら
            .Line.Transparency = 0  '線
            .Fill.Transparency = 0  '中身の塗りつぶし
        Else
            .Line.Transparency = 1  '線
            .Fill.Transparency = 1  '中身の塗りつぶし
        End If
    End With
 End Sub

 (ぶらっと)

ぶらっと様

解決しました！
ご丁寧にありがとうございました。
大変助かりました。

他の方々もご返答まことにありがとうございました。
（悠介）

 > .Line.Transparency = 0
 > .Fill.Transparency = 0

は

 .Line.Visible = False
 .Fill.Visible = False

 としてもいいようです。

 (シスボーベー)

シスボーベー様追加情報ありがとうございました。

重ね重ね恐縮なのですが、上記に付け加えて
その図形の中にテキストが入っていて、
テキスト全文も図形と合わせて見え隠れするようにするには
どう付け加えたらよいでしょうか？

（悠介）　

 シスボーベーさんのVisibleによる制御を拝借すると

 Sub 図形を見せたり隠したり2()
    With ActiveSheet.Shapes(Application.Caller)
        .Line.Visible = Not .Line.Visible
        .Fill.Visible = Not .Fill.Visible
        If .Line.Visible Then
            .DrawingObject.Font.ColorIndex = xlAutomatic
        Else
            .DrawingObject.Font.ColorIndex = 2
        End If
    End With
 End Sub

 (ぶらっと)

 トグル処理ってものがありましたね。
 すばらすぃ。
 (シスボーベー)

ぶらっと様

解決しました！思い通りにできて本当に助かりました。
シスボーベー様もありがとうございました。
ここの毛地盤の方はほんとうに親切ですしExcel詳しいですね。
自分も少しずつ勉強します<(_ _)>
（悠介）

何度もすみません。
さきほどいただいたマクロで実施してみたところ、
クリックして図形が消えたとき、フォントが白となり、
背景に色があると見えてしまっている状態となることに気づきました。
クリックするとテキストはクリア、もう一度クリックすると図形が現れテキストも元に戻る（見える）
という風にできないかと思い、

 Sub 図形を見せたり隠したり2()
    With ActiveSheet.Shapes(Application.Caller)
        .Line.Visible = Not .Line.Visible
        .Fill.Visible = Not .Fill.Visible
        If .Line.Visible Then
            .DrawingObject.Font.ColorIndex = xlAutomatic
        Else
            .DrawingObject.Characters.Text = Invisible
      End If
    End With
 End Sub

としてみましたところ、
テキストは消えるのですが、再度クリックしても
図形は現れますがテキストは消えたままです。
もう一度テキストも表示されるには
どう入力すればよろしいでしょうか？
※重ね重ね申し訳ありません。
（悠介）

あわせまして、

 Sub 図形を見せたり隠したり2()
    With ActiveSheet.Shapes(Application.Caller)
        .Line.Visible = Not .Line.Visible
        .Fill.Visible = Not .Fill.Visible
        If .Line.Visible Then
            .DrawingObject.Font.ColorIndex = xlAutomatic
        Else
            .DrawingObject.Font.ColorIndex = 2
        End If
    End With
 End Sub

ですと、１度クリックして図形がみえなくなり、もう１度クリックすると
なしにしていた図形の枠線が自動で現れてしまいます。

Sub 図形を見せたり隠したり()

    With ActiveSheet.Shapes(Application.Caller)
        If .Line.Transparency = 1 Then '透過度100%（隠れている状態）なら
            .Line.Transparency = 0  '線
            .Fill.Transparency = 1  '中身の塗りつぶし
        Else
            .Line.Transparency = 1  '線
            .Fill.Transparency = 1  '中身の塗りつぶし
        End If
    End With
 End Sub

のときはその点は解決されていました。

 つまり
１．対象の図形は、もともと枠線なし。
２．図形の下のセルには色がついている。

 ということだね。
１．については、対象の図形が全て枠線なしなら、Line を相手にせずFillだけにすればＯＫ。
ただし、あるものは枠線あり、あるものは枠線なし、それらを同じプロシジャでカバーしたいということなら
プロシジャの中で、図形に枠線があるのかないのかを判定して、それによってLine処理の要否を判断。
２．については、ちょっと悩ましいけど、「隠す」という処理を「背景のセルと同じ色にする」ということに
なるね。じゃぁ背景のセルの色は？　ということになると、その図形の下が「単一セル」なら、その色を
判定すればいいけど、複数セルにまたがっていて、それらセルにより、色が違っていると、たまたま図形の
中の文字の場所の下に、どの色があるのか、その判定は、ちょっと不可能に近いかな？
（ひねくりまわせばできると思うけど、大仰な構えになっちゃう）
それと、提示コードでは表示する場合、文字色をxlAutomatic(つまり黒）にしているけど、いやいや
元々は赤色だったなんてことなら、ここも、一ひねりしなきゃいけないね。

 このあたり、実際のそちらの要件は、どうなんだろう？

 (ぶらっと)

 とりあえず、このマクロで対象にする図形は「全て枠線なし」、かつ図形の下のセル色は、それが複数セルでも同じ色という前提で。

 Sub 図形を見せたり隠したり3()
    With ActiveSheet.Shapes(Application.Caller)
        .Fill.Visible = Not .Fill.Visible
        If .Fill.Visible Then
            .DrawingObject.Font.ColorIndex = xlAutomatic
        Else
            .DrawingObject.Font.ColorIndex = .TopLeftCell.Interior.ColorIndex
        End If
    End With
 End Sub

 (ぶらっと)

 お邪魔します。
 背景のセルの色、図形の枠線・塗りつぶし・テキストの有無、色等に関係なしに
 表示／非表示を切り替えるなら、こんな感じで。
 シート内に同じ名前の図形があったり、グループ化された図形等は考慮していません。

Sub Sample()

    Dim shp As Shape

    With ActiveSheet.Shapes(Application.Caller)
        If .AlternativeText Like "*: *" Or .AlternativeText = "" Then
            Set shp = .Duplicate
            shp.Left = .Left
            shp.Top = .Top
            shp.AlternativeText = .Name
            .Visible = False
            If .Name = shp.Name Then
                shp.Name = .Name & "_" & ActiveSheet.Shapes.Count
            End If
            shp.DrawingObject.Text = ""
            shp.Line.Visible = False
            shp.Fill.Visible = False
        Else
            ActiveSheet.Shapes(.AlternativeText).Visible = True
            .Delete
        End If
    End With
    Set shp = Nothing
 End Sub

 （あすなろ）

コメント返信：

[ 一覧(最新更新順) ]

[[20111126210215]] 『クリックすると現れる図形』（悠介） ページの最後に飛ぶ

[[20111126210215]]　『クリックすると現れる図形』（悠介）　ページの最後に飛ぶ