[[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

コメント返信：

[ 一覧(最新更新順) ]

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

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