• 締切済み

VBAでセルにポイント指定で斜線が引けませんか

tom04の回答

  • tom04
  • ベストアンサー率49% (2537/5117)
回答No.1

こんばんは! 質問に対する直接に回答にならないかもしれませんが・・・ あくまで私的見解です。 >1・ セルの横幅(横方向)にはポイントという位置付はないのでしょうか? ↓のサイトに載っていますが、個人的にセル幅(高さ)はポイントで意識したことはありません。 要は文字が収まるかどうか?が重要なのではないかと思います。 http://www.relief.jp/itnote/archives/000343.php 次に >(2)の件ですが、 ↓のコードは選択した最初のセルの中心から最後のセルの中心に矢印を引いています。 (B2:D10の範囲を選択した後にマクロを実行しています) Sub Sample1() Dim c As Range, r As Range, myRng As Range Set myRng = Selection Set c = Selection(1) Set r = Selection(Selection.Count) With ActiveSheet.Shapes.AddLine(c.Left + c.Width / 2, c.Top + c.Height / 2, r.Left + r.Width / 2, r.Top + r.Height / 2).Line .ForeColor.RGB = vbRed .Weight = 0.8 .EndArrowheadStyle = msoArrowheadTriangle End With End Sub ※ 画面上のセル幅(または高さ)のプラス加減で調整しています。 (厳密に○○ポイントではなく、見た目になります) ※ 仮に選択範囲の左上セルの左上角から右下セルの右下までというコトであれば >c.Left + c.Width / 2, c.Top + c.Height / 2, r.Left + r.Width / 2, r.Top + r.Height / 2 の部分を >c.Left, c.Top, r.Left + r.Width, r.Top + r.Height とすれば角から角までの矢印になります。 具体的に数値で簡単に矢印が引ける方法があればごめんなさいね。m(_ _)m

関連するQ&A

  • EXCEL マクロの指定の仕方

    マクロで線の色を指定したいのですが、上手くいかず困っています .ForeColor.RGB = Worksheets("sheet1").Range("F2").Interior.ColorIndex 赤色を指定したいのですがBにどういうコードを入れれば良いですか? FはVlookupで列Bより色を指定するようにしています。 マクロは始めたばかりで良く分からないので、他に必要な情報もわかりません 必要な情報なども併せて教えてください。 よろしくお願いします。 Dim rngStart As Range Dim rngEnd As Range Dim BX As Single, BY As Single, EX As Single, EY As Single Set rngStart = Worksheets("sheet2").Cells.Find(What:=Worksheets("sheet1").Range("D2"), LookIn:=xlValues, LookAt:=xlWhole) Set rngEnd = Worksheets("sheet2").Cells.Find(What:=Worksheets("sheet1").Range("E2"), LookIn:=xlValues, LookAt:=xlWhole) BX = rngStart.Left BY = rngStart.Top EX = rngEnd.Left + rngEnd.Width EY = rngEnd.Top With Worksheets("sheet2").Shapes.AddLine(BX, BY + 10, EX, EY + 10).line .ForeColor.RGB = Worksheets("sheet1").Range("F2").Interior.ColorIndex .Weight = 3 .EndArrowheadStyle = msoArrowheadTriangle End With

  • Excel VBAでの図形削除について質問です。

    Excel VBAでの図形削除について質問です。 ボタンをクリックすると、ラインを使って、直角三角形を作成できる様にしました。 その際に、画像を全て削除してから作成する様にしました。 しかし、コマンドボタンまで消えてしまい困っています。 Dim MyLine As Shape Dim rngStart As Range, rngEnd As Range Dim BX As Double, BY As Double, EX As Double, EY As Double Dim dellShape As Object Set dellShape = ActiveSheet dellShape.Shapes.SelectAll 'すべての図形を選択する Selection.Delete '現在選択されているオブジェクトを削除する 'Shapeを配置するための基準となるセル Set rngStart = Range("C30") Set rngEnd = Range("J11") 'セルのLeft、Top、Widthプロパティーを利用して位置決め BX = rngStart.Left BY = rngStart.Top EX = BX + 300 EY = BY + 0 'Shapeの描画 Set MyLine = ActiveSheet.Shapes.AddLine(BX, BY, EX, EY) '横幅 Set MyLine = ActiveSheet.Shapes.AddLine(EX, EY, EX, 200) '高さ Set MyLine = ActiveSheet.Shapes.AddLine(BX, BY, EX, 200) '斜辺 これで?削除?作図と出来るのですが、作図された図形をDeleteキーで手動で削除した後に、 もう一度コマンドボタンをクリックすると、コマンドボタンまで削除されてしまいます。 通常ではコマンドボタンは削除されないので、原因が解りません。 同じ経験をされた方や、ExcelVBAに詳しい方、アドバイスよろしくお願いいたします。

  • VBA 繰り返し処理について教えてください

    VBA初心者です。    A    B       C    D 1  2  項目 品名       数量   単位 3     内訳(別紙明細) 1     式 4     ブレーカ      1     ヶ 5     消耗品       1     式   6             7 8           小計 上記(見積書)のような表があり、『小計』の文字を検索して 行を挿入したり、斜め線を引くという内容をVBAでやりたいと思います。 以下が記述です。 ************************************************************* Sub 斜め線描画() Dim MyLine As Shape Dim rngStart As Range, rngEnd As Range Dim BX As Double, BY As Double, EX As Double, EY As Double Set c = Cells.Find(What:="小計", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart) If Not c Is Nothing Then firstAddress = c.Address Set rngStart = c.Offset(1, -1) Set rngEnd = c.Offset(-2, 0) BX = rngStart.Left BY = rngStart.Top EX = rngEnd.Left + rngEnd.Width EY = rngEnd.Top c.Offset(-2, 0).Select Selection.EntireRow.Insert ActiveCell.EntireRow.Select Selection.RowHeight = 2 c.Offset(1, 0).Select Selection.EntireRow.Insert ActiveCell.EntireRow.Select Selection.RowHeight = 2 Set MyLine = Sheet4.Shapes.AddLine(BX, BY, EX, EY) BX = BX + 151.5 BY = BY - 27 EX = EX - 152.25 EY = EY + 26.25 Set MyLine = Sheet4.Shapes.AddLine(BX, BY, EX, EY) End If End Sub **************************************************************** 『小計』の個数は決まっておらず、1個の場合もあれば10個の場合もあります。 『小計』があるだけ上記の処理を繰り返すようにしたいのですが、繰り返しの処理がうまくいかず、無限ループにはまってしまい困っています。 自分なりに考えたのは『小計』の文字はB列にあるので、B列に入力されている最後のセルまで検索したら処理を終了する。なのですが、どう記述していいのかわかりません。 文章がわかりにくいかもしれませんが、どうかご教授願います!

  • VBA OR条件での検索について教えてください。

    VBA初心者です。また質問させてください。 以前、下記のような表で、『小計』の文字を検索して行を挿入したり、斜め線を引くという内容をVBAでやる方法を教えていただきました。 その節はありがとうございました。 *************************************************************   A    B       C    D 1  2  項目 品名       数量   単位 3     内訳(別紙明細) 1     式 4     ブレーカ      1     ヶ 5     消耗品       1     式   6             7 8           小計 ************************************************************* 今度は『小計』だけでなく『合計』があった場合も、同じ処理をするVBAを作成したいのですがうまくいきません。 以下が記述です。 ************************************************************* Private Sub 斜め線描画_Click() Dim myLine As Shape Dim c As Range Dim cnt As Integer Dim i As Integer cnt = WorksheetFunction.CountIf(Cells, "*小   計*") Set c = Cells.Find(What:="小   計", LookIn:=xlFormulas, LookAt:=xlPart) If Not c Is Nothing Then i = 1 Call LineArranging(c) Do If i >= cnt Then Exit Sub 'カウントでチェック Set c = Cells.FindNext(c) If c Is Nothing Then Exit Sub Call LineArranging(c) i = i + 1 Loop End If Set c = Nothing End Sub Sub LineArranging(rng As Range) Dim BX As Double, BY As Double, EX As Double, EY As Double Dim rngStart As Range, rngEnd As Range Dim myLine As Shape rng.Select ActiveCell.Rows("1:2").EntireRow.Select Selection.Insert Shift:=xlDown rng.Offset(1, 0).Select ActiveCell.Rows("1:2").EntireRow.Select Selection.Insert Shift:=xlDown rng.Offset(-2, 0).Select Selection.EntireRow.Insert ActiveCell.EntireRow.Select Selection.RowHeight = 2 rng.Offset(1, 0).Select Selection.EntireRow.Insert ActiveCell.EntireRow.Select Selection.RowHeight = 2 Set rngStart = rng.Offset(1, -1) Set rngEnd = rng.Offset(-2, 0) BX = rngStart.Left BY = rngStart.Top EX = rngEnd.Left + rngEnd.Width EY = rngEnd.Top Set myLine = Sheet4.Shapes.AddLine(BX, BY, EX, EY) BX = BX + 151.5 BY = BY - 27 EX = EX - 152.25 EY = EY + 26.25 Set myLine = Sheet4.Shapes.AddLine(BX, BY, EX, EY) Set rngStart = Nothing Set rngEnd = Nothing Set myLine = Nothing End Sub ************************************************************* 『または』なのでorを使うのかと思ったのですが、エラーになりうまくいきません。どうしたらいいのか教えてください。 よろしくお願いします。

  • VBA 一致するセル同士を線で結ぶ

    ある列について(ここでは8列目)、あるセルを検索元セルとして、検索先のセルと一致したら検索元セルと検索先で一致したセルとを線(オートシェイプ)でつなぐようなVBAコードを書いています。 しかし何度やっても上手くセルの内容が一致するセル同士に線が引かれません。どこが悪いでしょうか? ちょっとせっぱつまっていて分かりづらい質問になっていますが、助けてください。お願いします。 Sub tameshi() Dim i, j As Integer For i = 1 To 100 If Cells(i, 8) = "" Then Else For j = i + 1 To 99 If Cells(i, 8).Text = Cells(j, 8).Text Then ' 横棒を引くための設定 ' 横線の終点はさらにその隣のセルを指定。 sx = Cells(i, 9).Left sy = Cells(i, 9).Top + 6 ex = Cells(i, 10).Left ' sx2に指定する座標 ey = Cells(i, 10).Top + 6 ' sy2に指定する座標 ' 縦棒を引くための設定 sx2 = Cells(i, 10).Left ' ここには上のexで指定した座標を指定 sy2 = Cells(i, 10).Top + 6 ' ここには上のeyで指定した座標を指定 ex2 = Cells(i + j, 10).Left ' 下のex3で指定した座標を指定 ey2 = Cells(i + j, 10).Top + 6 ' 下のey3で指定した座標を指定 ' 横棒を引くための設定 ' 実際にはつながれる先のセル番号(一致するIDの隣のセル)をexとeyに指定。 ' 横線の終点はさらにその隣のセルを指定。 sx3 = Cells(i + j, 9).Left sy3 = Cells(i + j, 9).Top + 6 ex3 = Cells(i + j, 10).Left ' ex2に指定する座標 ey3 = Cells(i + j, 10).Top + 6 ' ey2に指定する座標 ActiveSheet.Shapes.AddConnector(msoConnectorStraight, sx, sy, ex, ey).Select ActiveSheet.Shapes.AddConnector(msoConnectorStraight, sx2, sy2, ex2, ey2).Select ActiveSheet.Shapes.AddConnector(msoConnectorStraight, sx3, sy3, ex3, ey3).Select Else End If Next j End If Next i End Sub

  • 自動でセルの数値を変更したい

    自動でセルの数値を変更したいのですが、基本的な間違いがあるようで、できません何か別 な解決方法がありませんか、 ---------------------------------------------------- Sub 斜線オリジナル3() ' ' 斜線オリジナル3 Macro Set rngstart = Worksheets("時刻2").Cells(3, 9) Set rngend = Worksheets("時刻2").Cells(13, 25) BX = rngstart.Left BY = rngstart.Top EX = rngend.Left EY = rngend.Top '直線 With ActiveSheet.Shapes.AddLine(BX, BY, EX, EY).Line End With End Sub ------------------------------------------------- このコードは、参考にしたコードを自分が勝手に簡単にしたものです、知識rがあってやったものでは ありませんのでお許し下さい。理由はわかりませんが、なぜか一応は動作します。(斜線が引かれます。) 以上のコードで、Cells(3,9) と Cells(13,25) の列に相当する、9と25の数値を自動で変えたいのですが、  for cnt = 10 to 30 a = worksheets("時刻2").cells(3,cnt).value set rngstart = worksheets("時刻2").cells(3,a) のようにしたいのですが、エラーがでます。どのようにしたらいいでしょうか、教えて頂けませんか。

  • Excel VBA: セルの参照方法

    Excel VBAで、セルの範囲を指定するときには、 Range("A2:B3") とやりますよね。 ここのとこで、B3セルではなくBxセルにしたいときにはどうすればいいです?。 つまり、xは変数です。 Range("A2:Bx")と書いていいのでしょうか。

  • midステートメント セルを指定したい

    エクセルなのですが、 Sub N文字目を置換する1() Dim N As Long Range("a1").Value = "abcde" N = 2 '置換する文字の位置 ’start(省略不可) Mid(Range("a1").Value, N) = "X" MsgBox Range("a1").Value End Sub このように、セルを指定することはできないのでしょうか? このコードを実行しようとすると、 Mid(Range("a1").Value, N) = "X"の部分で「変数が必要です」とコンパイルエラーになります。 Sub N文字目を置換する2() Dim moji As String Dim N As Long Range("a1").Value = "abcde" moji = Range("a1").Value N = 2 Mid(moji, N) = "X" MsgBox moji End Sub このように、セルの値を一度変数に入れると問題なく実行できますが、 なぜダイレクトにmidステートメントでセルを指定できないのかわからないので教えてください。 よろしくお願いします。

  • vba 指定した日付範囲でセルの色を塗る

    急遽、エクセルVBAを組んでくれと頼まれたのでわかる方、教えていただけますか? 開始日時(A行)と終了日時(B行)があり、 開始と終了の範囲でC以降日付になっており 指定の範囲内でセルの色が塗られるいうものなのですが なにせ急ぎとVBAがほとんどわからないのでなるべくわかりやすく 教えていただけるとありがたいです。 ちなみにsheetにコードを記入するのとmoduleにコードを記入するのでは どう違うのですか?わからないまでも一応、色が塗られるところまでは できたのですがどうやってセルの時間を取得して範囲を指定すれば 良いのかなどがわかりませんどうかよろしくお願い致します。 下記は作成途中ですが・・・ Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim row As Integer Dim line As Integer row = 5 line = 9   Set objR = Range("A1").Resize(1, 4).Offset(1, 2) objR.Interior.ColorIndex = 8 End Sub

  • VBA 図形の移動をセル指定にしたい

    ワークシート上の図形を任意のセルで指定して その場所に移動させたいのですが 上手くいかないので質問します。 やりたいこと A1~A10セルに月・火・水・・・とランダムに 曜日が入っていて その中に、土という文字があれば その土とかかれたセルまで図形を持っていき さらにその図形をちょっと右にずらすという動きをさせたいです。 コードは下記を見て頂きたいのですが 図形の指定や図形をちょっと右にずらすのはできたのですが 土とかかれたセルの位置に持ってくるのがどうしてもできませんでした どうすれば指定した位置に図形を持ってこれるのでしょうか? すいませんがコードを記載してもらえると助かります。 回答よろしくお願いします。 Sub 図形移動() Dim a As Variant For a = 1To 10 If Cells(a, 1).Value = "土" Then ActiveSheet.Shapes("Rounded Rectangle 29").Select  Selection.ShapeRange.IncrementLeft 90 End If Next a End Sub