[[20140819194805]] 『セルダブルクリックでオートシェイプ表示』(ken) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『セルダブルクリックでオートシェイプ表示』(ken)

エクセルで工程表を作っています。

A9からZ9セルをダブルクリックすると クリックしたセルにオートシェイプでAAA
A10からZ10セルだとBBB と表示させたいのですが・・・
行は全部で50行です。

他の方のQ&Aで一番最初の行は出来たのですが 二行目からが出来ません。

宜しくお願いします。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

 If Intersect(Target, Range("A9:Z9")) Is Nothing Then Exit Sub
With ActiveSheet.Range(Target.Address)
 ActiveSheet.Shapes.AddShape(Type:=msoShapeRoundedRectangle, _
 Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height).Select
 Selection.Characters.Text = "AAA"
 Selection.AutoSize = True
 Selection.ShapeRange.Fill.ForeColor.SchemeColor = 43
 Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
  End With
    With Selection.Font
        .ColorIndex = 4
 End With
 End Sub

< 使用 Excel:Excel2003、使用 OS:Windows7 >


 >行は全部で50行です。
 という事ですが、3行目以降は何と表示させますか?

 行毎にそれぞれ別の文字が割り当てられているのか
 AAAとBBBの繰り返しなのか
 1行目だけAAA で、2行目以降はBBB なのか。。。?

 また、AAA,BBBはサンプルなのか
 実際もAAA,BBBなのか。。。?
  
(HANA) 2014/08/19(火) 20:23

AAA BBB はサンプルです。
実際は 基礎工事 組立工事 足場工事 等 50の項目があります。
(ken) 2014/08/19(火) 20:31

 こんな感じですか?

 '------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim MyString As String, MyShape As Shape
    If Intersect(Target, Range("A9:Z50")) Is Nothing Then Exit Sub

    With Target
        If .Row = 9 Then MyString = "AAA"
        If .Row = 10 Then MyString = "BBB"
        If .Row = 11 Then MyString = "CCC"
        If .Row = 12 Then MyString = "DDD"
            '同様に50件追加

        ActiveSheet.Shapes.AddShape(Type:=msoShapeRoundedRectangle, _
                Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height).Select
    End With

    Selection.Characters.Text = MyString
    Selection.AutoSize = True
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 43
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
    Selection.Font.ColorIndex = 4
End Sub
 '------
  
(HANA) 2014/08/19(火) 20:50

HANAさま

ありがとうございます。

何日も頭を悩ませたのに こんな短時間で出来るなんて・・・
感謝致します。

行ごとに オートシェイプの色を変える事は可能でしょうか?
(ken) 2014/08/19(火) 21:17


 表示する文字を 変数:MyString に入れて
    Selection.Characters.Text = MyString
 とした様に、何か変数を作って
 該当部分を変更してもらったら良いと思います。
  
(HANA) 2014/08/19(火) 21:45

 >実際は 基礎工事 組立工事 足場工事 等 50の項目があります。
 この文字が、どこかの列に入っていたりしませんか?

 AA列にでも、各行の項目を入れて セルの色をオートシェイプと同じ色にして
 そこから取得する様にすると、メンテナンスが楽になるかもしれません。

 '------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim MyCul As String

    MyCul = "AA" '項目を入力した列に変更の事

    If Intersect(Target, Range("A9:Z50")) Is Nothing Then Exit Sub

    With Target
        If Range(MyCul & .Row).Value <> "" Then
            ActiveSheet.Shapes.AddShape(Type:=msoShapeRoundedRectangle, _
                    Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height).Select

            Selection.Characters.Text = Range(MyCul & .Row).Value
            Selection.AutoSize = True
            Selection.ShapeRange.Fill.ForeColor.RGB = Range(MyCul & .Row).Interior.Color
            Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
            Selection.Font.ColorIndex = Range(MyCul & .Row).Font.ColorIndex
        End If
    End With
End Sub
 '------
  
(HANA) 2014/08/19(火) 22:20

HANAさま

ありがとうございます。
頑張ってみます。
(ken) 2014/08/19(火) 22:50


HANAさま

やりたかった事 そのものです。

本当にありがとうございました。
(ken) 2014/08/20(水) 00:16


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.