EXCEL VBAのshapeで線分の色指定
- EXCEL VBAのshapeのコードで線分の色指定がうまくいかない場合の解決方法について教えてください。
- ブレークポイントを設定すると線分の色が黒になってしまう問題について解説してください。
- shapeを使用して線分を描いた際に、色指定が正常に反映されない場合の対処方法を教えてください。
- ベストアンサー
EXCEL VBAのshapeで線分の色指定
EXCEL VBAのshapeの下記のコードで複数の線分を描いていますが、ブレークポイントを設定してステップ送りすると最初の１本目の線分に指定した色が付かず黒の線分になります。ブレークポイントを設定しないで連続動作させると全て黒の線分になってしまいます。 shapeを使用している部分は、この他にワードアートの部分だけです。 ワードアート部分を全てコメントに変更しても動作は変わりません。 shape部分のコードは以下の通りです。 Worksheets("sheet1").Shapes.AddLine(beginx:=xA, beginy:=yA, endx:=xB, endy:=yB).Select With Selection .ShapeRange.Line.ForeColor.SchemeColor = 2 End With ワードアートのコードは以下の通りです。 MyShape = Worksheets("深度図").Shapes.AddTextEffect(msoTextEffect1, str_C & str_D, "MS ゴシック", 9, msoTrue, msoFalse, x_pos, y_pos) どなたかこのような経験をされた方がいらっしゃったら、回答をお願いします。
- monkeyponchi
- お礼率100% (1/1)
- Visual Basic
- 回答数1
- ありがとう数4
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
マクロを記録すると Select～ とか、Active～ が良く出てくるけど、 これって選択状態にならなきゃいけない、つまりフォーカスを受け取れる 状態で無いと失敗するはずです。 ブレークポイントを指定すると、Active な Window はコードの画面では？ Active な Window しかフォーカスは受け取れませんから、Selection とか 全部使えないと思います。 (だから職業プログラマレベルの人は、Select～ とか、Active～ という キーワードの無いプログラムを書きます) Dim MyShape As Excel.Shape Set MyShape = Worksheets("sheet1").Shapes("ShapeTest") MyShape.Fill.ForeColor.RGB = RGB(255, 0, 0)
関連するQ&A
- エクセルVBAでの複数のオートシェイプの色塗り方法
ネットから下記のコードを見つけたのですが、１つのシートに複数のオートシェイプの色塗りを変更する方法を教えてください。 例えばセル"A1"には数値の1と"A2"には数値2を入力したら、 オートシェイプAにはセル"A1"に対応した色塗り『赤色』を オートシェイプBにはセル"A2"に対応した色塗り『黄色』といった感じです。 下記のコードをいくつも繋げれば、複数のオートシェイプの色塗りが出来ると思ったのですが、コードを繋げる方法がわかりません。その他に何か良い方法がありましたら教えてください。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(0, 0) <> "A1" Then Exit Sub With ActiveSheet.Shapes("ABC").Fill.ForeColor Select Case Target.Value Case Is = "赤" .SchemeColor = 2 Case Is = "黄" .SchemeColor = 5 Case Is = "緑" .SchemeColor = 3 Case Is = "青" .SchemeColor = 4 Case Else .SchemeColor = 1 End Select End With End Sub
- ベストアンサー
- Visual Basic
- エクセルVBAオートシェイプがあったら、の書き方
皆さんこんにちは。 エクセルVBAの初心者です。 IFを使った条件分岐が私には難しかったので SELECTCASEを用いてみようと思うのですが条件の書き方が分かりません。 やりたい事は セルA1が「文字が入っていない且つオートシェイプが入っていない場合」のみ アクション（オートシェイプ☆を貼る）を起こしたい、です。 イメージ的にこうなるかな？と思いコードを作成しましたが ケース2の「オートシェイプがあったら」という条件の書き方が分かりません。 Sub オートシェイプ貼り付け() With ThisWorkbook.Worksheets("Sheet1") Select Case True Case .Range("A1").Value <> "" Exit Sub Case オートシェイプがあったら Exit Sub Case Else オートシェイプ☆を貼る End Select End Sub オートシェイプの有無を条件にするにはどのような書き方をすれば良いでしょうか？
- ベストアンサー
- Excel（エクセル）
- ＶＢＡでセルにポイント指定で斜線が引けませんか
excel vbaでセル幅、高さを小さくした画面のその上に指定したところから指定したところに別に用意した複数の数値により自動で複数の斜線を引きたいのですが，下記の参考コードを見つけ検討しましたが、目的の結果が得られません、どなたか方法を教えて頂けませんか、 参考コードでは、下段のコード部分で、セルの縦幅(側辺）をポイント指定でセルの任意の位置から位置に引けますが上段部分のコードでは、セルの始端、終端の位置のみに対応できてセルの横辺（セルの横幅）についてのポイント指定ができません。 下段のコードのポイント指定は Ｆｏｒ cnt = 20 to 30 等で複数指定しますと自由に複数の横線を引くことができます。 質問 １・ セルの横幅（横方向）にはポイントという位置付はないのでしょうか。もしあるとしたらどの様に 指定するのでしょうか。また１セルのポイントはいくつでしょうか。 2・ セルの始端、終端の位置を利用する場合、range（"c10"),range("g10")の内容を自動で、変える 方法はありませんか。 ------------------------------ 参考としたコード Dim rngstart As Range, rngend As Range Dim BX As Single, BY As Single, EX As Single, EY As Single 'shape を配置するための基準となるセル Set rngstart = Range("c10") Set rngend = Range("g10") 'セルのleft,top,widthプロパティを利用して位置決め BX = rngstart.Left BY = rngstart.Top EX = rngend.Left + rngend.Width EY = rngend.Top '直線 ActiveSheet.Shapes.AddLine BX, BY, EX, EY With ActiveSheet.Shapes.AddLine(BX, BY + 10, EX, EY + 10).Line .ForeColor.RGB = vbRed .Weight = 0.8 .EndArrowheadStyle = msoArrowheadTriangle End With End Sub 以上。です。 よろしくお願いいたします。
- 締切済み
- Excel（エクセル）
- VBAでオートシェイプのグループ化についての質問です。
VBAでオートシェイプのグループ化についての質問です。 オートシェイプ線（Line）で台形を作成し全てを選択し、グループ化したいと考えています。 また、連続して台形を作成していきたいと考えています。 ?4本線を引く ?グループ化（Aグループ） ?4本線を引く ?グループ化（Aグループ） ⇒ 連続して作成・・・ Dim st() As Variant Dim ob As Shape Dim MyLine As Shape '線の作成 Set MyLine = ActiveSheet.Shapes.AddLine(startX, startY, widthX, heightY) '線の選択 For Each ob In ActiveSheet.Shapes ReDim Preserve st(j) st(j) = ob.name j = j + 1 Next ob 'グループ化 Worksheets("test").Shapes.Range(st).Select Selection.ShapeRange.Group.Select と上記コードで一つのグループは作成出来たのですが、次に作成すると Worksheets("test").Shapes.Range(st).Select Selection.ShapeRange.Group.Select でエラーになります。 恐らく前のグループ化内の線も選択してしまうのではないかと思っていますが、対処の仕方が解りません。 線の作成方法から選択方法等いろいろ意見が聞きたいと思っています。 アドバイスよろしくお願いいたします。 m(__)m
- ベストアンサー
- その他（プログラミング・開発）
- EXCEL VBA で自在に図形を変化させたい(2)
前回，質問させてもらい、非常に役に立つ回答をもらい解決しました。 今回、いろいろ本を見ても解決できない問題がありましたので再度質問をします。 EXCEL上にコマンドボタンを一つ配置します。右クリック→プロパティ→オブジェクト名をCmd作図に変更しておきます。 デザインモードでボタンをダブルクリックしてVBEでコード表示にします。 Private Sub Cmd作図_Click() ActiveSheet.Shapes.AddLine 200, 200, 400, 400 End Sub これでEXCEL上のコマンドボタンを押すと直線が作図できます。 次にAddLine以下の数字を変えて再度実行しますと別の直線がかけるのですが最初の直線が残ったままですので重なったりします。 前回、回答では Private Sub Cmd作図_Click() With ActiveSheet For Each Sh In .Shapes Sh.Delete Next Sh ActiveSheet.Shapes.AddLine 200, 200, 400, 400 End With End Sub という回答をもらっています。こうすれば前回描いた線を消してから作図できます。 しかし、前回は「マクロの実行」ボタンからの作図でしたので問題にはならなかったのですが、今回、EXCEL上にコマンドボタンを配置したところ、コマンドボタンもShapesと認識してしまうらしく、線と一緒に消されてしまいます。 この問題を解決できるコードを教えてもらいたいのですが。 よろしくお願いします。
- ベストアンサー
- Visual Basic
- エクセルVBAでShapeRangeについて
すみません、教えてください。 以下のマクロは正常に動きます。 Sub TEST() With ActiveSheet For Each s In .Shapes If s.AutoShapeType = msoShape5pointStar Then s.Delete Next .Cells.Interior.ColorIndex = 1 Set AA = .Shapes.AddShape(msoShape5pointStar, 55, 22, 25#, 25#) AA.Fill.Visible = msoTrue AA.Fill.Solid AA.Fill.ForeColor.SchemeColor = 13 AA.Fill.Transparency = 0# AA.line.Weight = 0.75 AA.line.DashStyle = msoLineSolid AA.line.Style = msoLineSingle AA.line.Transparency = 0# AA.line.Visible = msoTrue AA.line.ForeColor.SchemeColor = 64 ' AA.Copy '(1) ' .Paste '(1) ' Set AB = Selection '(1) ' .Range("A1").Select'(1) Set AB = AA.Duplicate '(2) AB.Top = 44 AB.Left = 110 ' AB.ShapeRange.Fill.ForeColor.SchemeColor = 10'(1)の２ AB.Fill.ForeColor.SchemeColor = 10 '(2)の２ End With End Sub ところが、 Set AB = AA.Duplicate '(2)の部分を、コメントアウトしている '(1)の記述に変えると、 AB.Fill.ForeColor.SchemeColor = 10 '(2)の２ の部分も ' AB.ShapeRange.Fill.ForeColor.SchemeColor = 10'(1)の２ に変えないとエラーになります。 ' AA.Copy '(1) ' .Paste '(1) ' Set AB = Selection '(1) も Set AB = AA.Duplicate '(2) も、同じことのように思えるのですが、この違いで、ShapeRangeというのを入れたり消したりしなければならないのはどうしてでしょうか？ エクセルは2000です。
- ベストアンサー
- オフィス系ソフト
- エクセルVBAでオートシェープの連番はいくつまで使えますか？
シート上にオートシェープを配置すると、自動で名前と番号が振られます。（直線 125 とか 図 126とか） この番号は連番になっており、配置したオートシェープを全て削除してファイルを保存しても、次回はオートシェープが何もないにもかかわらず、次の番号から採番されます。 この番号はいったい幾つまで続くのでしょうか？ 下記VBAを試してますが、現在7万番台でもまだ有効に採番されます。 ある番号になったらそれ以上オートシェープが作れなくなるという話も聞きましたので質問します。 Sub test01() Randomize With ActiveSheet .Cells.Interior.ColorIndex = 1 CL = Int((50 * Rnd) + 1) L1 = Int((700 * Rnd) + 20) H1 = Int((450 * Rnd) + 20) Set SA = .Shapes.AddShape(msoShape5pointStar, L1, H1, 25, 25) SA.Name = "Merlion_" & SA.Name SA.Fill.ForeColor.SchemeColor = CL For n = 1 To 100 CL = Int((50 * Rnd) + 1) L2 = Int((600 * Rnd) + 20) H2 = Int((300 * Rnd) + 20) SA.Top = H2 - SA.Width / 2 SA.Left = L2 - SA.Height / 2 SA.Fill.ForeColor.SchemeColor = CL Set SL = .Shapes.AddLine(L1, H1, L2, H2) SL.Name = "Merlion_" & SL.Name Application.StatusBar = SL.Name SL.line.Weight = 0.75 SL.line.ForeColor.SchemeColor = CL L1 = L2 H1 = H2 Next SA.ZOrder msoBringToFront SA.line.Visible = True SA.line.ForeColor.SchemeColor = CL For i = 1 To 800 Step 60 SA.Rotation = i / 10 SA.line.Weight = i DoEvents Next For Each s In .Shapes If s.Name Like "Merlion_*" Then s.Delete Next .Cells.Interior.ColorIndex = xlNone End With End Sub
- ベストアンサー
- オフィス系ソフト
- エクセル マクロで引いた線の色設定が戻せない
エクセルで作成した、出席簿にマクロで 土日などに赤線で罫線の間に縦に オートシェィプ直線を引いています。 次に転出者の欄には、横に線をマクロで引いていますが 色が変えられません。 マクロ終了後もオートシェイプの線色は黒でも 、線を引くと赤のままです。 その線を選択して、色を変えないと 変えられない状態です。 マクロ終了前に、色をリセットする事は出来ませんか？ 下記の内容がマクロの一部です。 よろしくお願いします。 If yobi = doyo Or yobi = niti Then Cells(3, 2 + n).Activate If yobi = niti Then With Selection.Font .ColorIndex = 3 End With End If ActiveSheet.Shapes.AddLine(110.25 + 21.75 * (n - 1), 42, 110.25 + 21.75 * (n - 1), 651).Select Selection.ShapeRange.Line.ForeColor.SchemeColor = 10 '10=赤色 End If If yobi = "" Then ActiveSheet.Shapes.AddLine(110.25 + 21.75 * (n - 1), 14.25, 110.25 + 21.75 * (n - 1), 651).Select Selection.ShapeRange.Line.ForeColor.SchemeColor = 8 '8=黒色 End If
- 締切済み
- オフィス系ソフト
- excel vba でtextboxの色、線を消す
ｅｘｃｅｌ VBA の中でtext boxを作成しその中に文字を転記します。その際中の文字だけを表示し塗りつぶしなし、,線なしにしたいのですが何か方法はありませんか。手動で、図形書式の設定の、塗りつぶしなし,線なし、にすればできますが、次に作成するともとに戻ってしまいます。 コードは、下記のコードです。 dim temp as shape t = worksheets("ダイヤ").range("q93").value for j = 73 to t step 1'駅数の数NEXT m = worksheets("ダイヤ").range("f110").value’表示位置調整 k = worksheets("ダイヤ").cells(j + m.17).value’表示位置取得 set temp = worksheets("ダイ ヤ ").shapes.addtextboxmsotextorientationhorizontal.32,k,65,17)’textbox作成 temp. textframe.characters.text = worksheets("ダイヤ").cells(j,15).value、駅名転記 next j このコードで現在textboxを作成その中に文字を転記できますが、ボックスも表示されされてしまいま す、ボックスは消し、文字だけ表示することはできませんか。 何方か教えて頂けませんか。
- ベストアンサー
- Excel（エクセル）
- excel VBA で条件の設定方を教えて下さい。
今、斜線を引きその斜線データの最初のセルに数値で（１とか３とかの数値の）条件をつけて置き、その条件で、太さ、色等を変えて斜線を引きたいのですがうまくいきません。何方か教えて頂けませんか。 --------------------- dim myrange as range workheets("補助計算").range("c8:c47").value = worksheets("時刻").range("c8:c47").value workheets("補助計算").range("g8:h47").value = worksheets("時刻").range("g8:h47").value with worksheets("時刻") v=worksheets("時刻").range("m2").value+12'描画本数 for i = 12 to v step 1'設定可能本数50本 set myrage = worksheets("補助計算").range("t3:t47") myrange.value = .range(.cells(3,i),.cells(48,i)).value for cnt = 75 to 113 step 2 e = worksheets("ダイヤ").cells(cnt,10).value f = worksheets("ダイヤ").cells(cnt,11).value g = worksheets("ダイヤ").cells(cnt+1,10).value h = worksheets("ダイヤ").cells(cnt+1,11).value with worksheets("ダイヤ").shapes.addline(e,f,g,h) .line.weight = 1.1 .line.forecolor.rgb = vbblue end with next cnt next i end with ----------------------- 上記コードで、斜線が何本か引かれます、その際、データ元のセルに数値の条件、例えば、1 とか3とかの数値を入力されているときは、それによって、斜線の色、又は線の太さをかえたいのですが、指定の仕方は、時刻シートの時刻の上欄セルに、線の指定のセル、太さ指定のセルに別々に指定おき、それを参照して、線の色、太さをかえたいのですが、いろいろ試みましたがうまくいきません。上記コードにどのように追加コードをすればよいか何方か教えていただけませんか。できれば、線の色は３色以上設定できればありがたいです。、
- ベストアンサー
- Excel（エクセル）
お礼
MARU4812さん、早速の回答有難うございます。 つまりは、線を引くシートをアクティブにしておいて、そのコマンドを実行しろということと理解できました。実際にやってみてうまくいきました。有難うございます。助かりました。 まだまだ素人ですので、また何か質問させていただくかもしれませんが、宜しくお願いします。