ここから本文です

 Private Function ChangeFlg(Sh As String) As Boolean   Set A = ActiveSheet.S...

tom********さん

2014/4/319:58:12

 Private Function ChangeFlg(Sh As String) As Boolean
  Set A = ActiveSheet.Shapes(Sh)
 
  With ActiveSheet.Shapes(Sh).DrawingObject.ShapeRange.Fill
   
    If .Visible = mso

True Then
       .Visible = msoFalse
      ChangeFlg = False
   
    Else
      .Visible = msoTrue
      .ForeColor.SchemeColor = 8
      ChangeFlg = True
     
    End If
  End With
 
  End Function

-------------------------------------------------------------------

Sub 四角形80_Click()

  ActiveSheet.Range("CC5").Value = ChangeFlg(Application.Caller)
 
End Sub
 
Sub 四角形81_Click()

  ActiveSheet.Range("CC6").Value = ChangeFlg(Application.Caller)

End Sub

Sub 四角形82_Click()

  ActiveSheet.Range("CC7").Value = ChangeFlg(Application.Caller)

End Sub







複数ある四角形がクリックする度に□⇔■になり、対象のセルが
TRUE・FALSEになる様にしております。

これに四角形80が塗りつぶされていない時に四角形81をクリック
したら、四角形80も黒く塗りつぶされ、四角形80の対象のセルも
TRUEになるという事をしたいです。

色々試したのですが、なかなかうまくいかず、質問させて頂きました。

すいませんが、おわかりになる方ご教授頂けないでしょうか?

使用しているのはEXCEL2007でVisual Basic6.5です。

携帯からの為、改行など見苦しいかもしれませんが、何卒よろしくお願い致します。

閲覧数:
152
回答数:
2

違反報告

ベストアンサーに選ばれた回答

プロフィール画像

カテゴリマスター

hot********さん

2014/4/400:18:27

文章の「四角形80も黒く塗りつぶされ」の「も」の所から「四角形80が塗りつぶされていなければ」なのか「四角形80と四角形81が塗りつぶされていなければ」なのかがあいまいだと思います。
「四角形80が塗りつぶされていない時に」の条件になっていますが「四角形80と四角形81が塗りつぶされていなければ」の条件もコメントになっています。

それと、ChangeFlgは整理できると思うので整理してます。
>im A As Shape
>et A = ActiveSheet.Shapes(sh)
は使っていないので削除しました。
ちなみに、.ForeColor.SchemeColor = 8 はデザイン時に指定してあれば後は不要なので、
If .ForeColor.SchemeColor <> 8 Then .ForeColor.SchemeColor = 8
も不要です。


Private Function ChangeFlg(sh As String) As Boolean
With ActiveSheet.Shapes(sh).DrawingObject.ShapeRange.Fill
If .ForeColor.SchemeColor <> 8 Then .ForeColor.SchemeColor = 8
.Visible = Not .Visible
ChangeFlg = (.Visible = msoTrue)
End With
End Function
'
Function callerName(s As String) As String
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
If sh.OnAction = s Then
callerName = sh.Name
End If
Next
End Function
' -------------------------------------------------------------------
Sub 四角形80_Click()
ActiveSheet.Range("CC5").Value = ChangeFlg(Application.caller)
End Sub

Sub 四角形81_Click()
If ActiveSheet.Range("CC5").Value = False Then ActiveSheet.Range("CC5").Value = ChangeFlg(callerName(ThisWorkbook.Name & "!四角形80_Click")) '四角形80が塗りつぶされていない場合
'If (ActiveSheet.Range("CC5").Value = False) And (ActiveSheet.Range("CC6").Value = False) Then ActiveSheet.Range("CC5").Value = ChangeFlg(callerName(ThisWorkbook.Name & "!四角形80_Click")) '四角形80と四角形81が塗りつぶされていない場合
ActiveSheet.Range("CC6").Value = ChangeFlg(Application.caller)
End Sub

Sub 四角形82_Click()
ActiveSheet.Range("CC7").Value = ChangeFlg(Application.caller)
End Sub

質問した人からのコメント

2014/4/4 17:02:31

降参 質問が曖昧にも関わらず意図した事を汲み取って回答頂き誠にありがとうございます。

おかげさまで無事うまくいく事ができました。

大変助かりました。

次回からは条件を具体的に書く様に心掛けます。
その際はまたよろしくお願いします。

本当にありがとうございました。

ベストアンサー以外の回答

1〜1件/1件中

por********さん

2014/4/409:45:52

こんにちは。
やりたいことをそのままコードにすると、
Sub 四角形2_Click()
If ActiveSheet.Range("C5").Value = True Then
Else
ActiveSheet.Shapes("四角形 1").DrawingObject.ShapeRange.Fill.Visible = True
ActiveSheet.Range("C5").Value = True
End If
ActiveSheet.Range("C6").Value = ChangeFlg(Application.Caller)
End Sub

あ、テスト用に1から3の3つの四角を作って、2のクリックのときのコードです

個別なんだから、直接名前を指定したんですが、こんな動作ですかね。
名前で、四角形スペース1になっていましたね。80もそうなんでしょう。

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる