[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『セルダブルクリックでオートシェイプ表示』(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
こんな感じですか?
'------ 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
ありがとうございます。
何日も頭を悩ませたのに こんな短時間で出来るなんて・・・
感謝致します。
行ごとに オートシェイプの色を変える事は可能でしょうか?
(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
ありがとうございます。
頑張ってみます。
(ken) 2014/08/19(火) 22:50
やりたかった事 そのものです。
本当にありがとうございました。
(ken) 2014/08/20(水) 00:16
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.