Excel VBA ｵｰﾄｼｪｲﾌﾟ上のｾﾙ位置取得後、そのｾﾙ位置の日付を取得する方法について

Question

以前このサイト内で質問させていただきマクロを教えていただいたものです。
下記コードにて開始日・終了日の取得は　”数値”にて取得できたと思っていたのですが
矢印線の誤差なのか分かりませんが
終了日が短くなったりちょうどになったりします。
矢印線挿入はﾏｸﾛにてｱｸﾃｨﾌﾞｾﾙに挿入していますのでｾﾙに対してはぴったり収まっているはずですが
誤差で終了日が変わってきます。
何とかしたいですが分からない状況です。
あともう一つしたいのが現状は開始日も終了日も”数値にて取得しているため
開始日と終了日をTodayに対して遅れているか等の計画の見える化ができないです。
条件付でｾﾙに色付したいので日付にて取得する必要があります。
因みに

お手数かけますが分かる方いらっしゃいましたらご教示お願いします。



Sub 納期更新()
Dim s As Object, Data() As Integer
Dim rMax As Long, rw As Long, cl As Long
rMax = Cells(Rows.Count, 1).End(xlUp).Row
ReDim Data(rMax, 1)
Range("H10").Resize(rMax - 9, 2).ClearContents
rw = 0
For Each s In ActiveSheet.Shapes
   If s.AutoShapeType = -2 And rw <= rMax Then
  rw = s.TopLeftCell.Row
      If Data(rw, 0) = 0 Then
      Data(rw, 0) = s.TopLeftCell.Column
    Else
      Data(rw, 0) = Application.Min(Data(rw, 0), s.TopLeftCell.Column)
    End If
    Data(rw, 1) = Application.Max(Data(rw, 1), s.Left + s.Width)
  End If
Next s
For rw = 9 To rMax
  cl = Data(rw, 0)
  If cl > 0 Then
    Cells(rw, 8).Value = cl - 10
    While Cells(1, cl ).Left <= Data(rw, 1)
      cl = cl + 1
    Wend
    Cells(rw, 9).Value = cl - 10
  End If
Next rw

めぐみん_ · Accepted Answer

こんな感じですかね。
ユーザーフォームにコマンドボタンを配置して実行って方法です。

Private Sub CommandButton1_Click()
Dim Re As Range
Dim v As Variant, vv As Variant

For Each Re In Range(RefEdit1.Value).Areas '取得したセル範囲を固まり毎に分割(Areas)してます。
With ActiveSheet.Shapes.AddLine(Re.Left, Re.Top + Re.Height / 2, Re.Left + Re.Width, Re.Top + Re.Height / 2).Line
.ForeColor.RGB = RGB(0, 0, 0)
.Style = 1
.BeginArrowheadStyle = 1
.EndArrowheadStyle = 3
.Weight = 1
.DashStyle = msoLineDash
End With

v = Split(Re.Address, ":")

With Cells(Re.Row, "H")
.Value = IIf(.Value = "", Cells(6, Range(v(0)).Column).Value, Application.Min(.Value, Cells(6, Range(v(0)).Column).Value))
End With

With Cells(Re.Row, "I")
.Value = IIf(.Value = "", Cells(6, Range(v(UBound(v))).Column).Value, Application.Max(.Value, Cells(6, Range(v(UBound(v))).Column).Value))
End With

Next Re
End Sub

－－－－－－

IIf は If~Then Else End If を短くした感じの物です。
内容的には同じで、
IIf(条件式, Trueの場合, Falseの場合)
主に変数の値を条件によって変えたい場合に使うものです。

６行目が今まで通りの数値でも、No.9に書いたように日付（表示形式を変えてても）であっても（セルの書式設定で調整）対応できると思います。

fujillin · Answer

こんばんは

前回の回答者です。
矢印線の実態が不明でしたので、回答時にご質問のような懸念と対処法についても記しておいたつもりなのですが。

現在エクセル環境がないので、考え方のみの回答になってしまいますが・・・

マクロで矢線を作成なさっているとのことですので、矢線の種類も限定できるでしょうから、前回のNo7様の指摘のようにShapesで取らずに、限定して処理をするようにした方が安全側になると考えられます。
矢線作成時にセルの境界ピッタリに線を引くと、エクセルが扱うポイント値の最小単位の関係からどちらかのセルに微妙にずれ込むことも考えられます。

簡単な対処法としては、黙視ではわからない位の差分（ε）をあらかじめ設定しておいて、線分の始点は+ε、終点は-εとして描画するようにしておけば、判定がずれるようなことはなくなると考えられます。

描画はそのままで判定側で対処するなら、同様に、始点を+ε、終点は-εと読み替えてから判断すればよいでしよう。
ただしこの場合は、TopLeftCellで判断するのではなく、実際の位置を示すポイント値（Top）を用いることになります。

また、状況が不明でしたので回答にはあえて利用しませんでしたが、推測するところ、一日分のセル幅はみな同じ幅に設定されていそうな気がしますので、始点－終点間の長さをセル幅で除して四捨五入すれば、簡単に日数を求めることができるはずです。
これを利用すれば、始点位置の日にちを求めれば、終点は長さ分の日数を加えることでも求めることができると考えられます。

めぐみん_ · Answer

＞矢印線挿入はﾏｸﾛにてｱｸﾃｨﾌﾞｾﾙに挿入していますので

前回の質問では手作業にて書き込んだ矢印に対して処理をすると私（他の方も？）思いましたので、オートシェイプでの回答を検討しました。

けどマクロにてアクティブセル（選択している複数セル？）に描画するよう作成しているのであれば、その時のセル番地は取得できる訳ですから前回私が回答した Union を使ってセル番地を結合しておき、
最初と最後のセルから列を取得して日付の行と重ねれば日付の値は取得可能なのでは？
後々修正が入るってなら各行毎にそれまでの開始・終了セル番地を使用していない列の同行に書き込むなどで一時保存も良いように思いますけど。

なのでオートシェイプを描画した後（描画する事）で悩むより、描画させるためのセル選択情報を有効利用した方が宜しいのではないでしょうか？
そうすればオートシェイプのズレ云々は考えずに済みますし。
またセル選択自体がユーザーフォームで日付を指定しているなら、そちらの値を利用する方法の検討は有効かと。

fujillin · Answer

No1です

少し、落ち着いて考えてみましたが・・・

＞セル選択してから描画してるのですがそのような場合にも
＞差分を指定して描画できるのでしょうか？
セルを選択してるってことは、日にちを指定してるってことなので、マクロで線を引く際に併せて開始日、終了日も記入するようにするのが一番良さそうですね。

既に開始日、終了日が記入されているなら、それとの合成で記入するようにしておけば、常に最新情報で記入されている状態になります。

ご質問の内容である、「後から矢印を判定して、日にちを算定する」という処理そのものも必要が無くなります。

fujillin · Answer

No3です

＞参考コードなどありましたら教えていただきたいです。
ん～～っと。何の参考なんだろう？

『矢線作成時に併せて日にちを記入する』方の参考でしょうか？

とはいっても、質問者様が現状どのようにして矢線を作成なさっているのかわからないので、仮に、r行目のn日からm日まで矢線を引く場合を想定します。
（矢線は引けているのでしょうから、その後に日にちのセットをすれば良いものとして）
単純に記入するだけなら、
　Cells(r,8).Value = n
　Cells(r,9).Value = m
のような感じで、開始日、終了日がセットできます。

通常は、その前に既に値が入っているはずですので、開始日は小さい方の値、終了日は大きな方の値を採用することにして、
　Cells(r,8).Value = Application.Min(Cells(r,8).Value, n)
　Cells(r,9).Value = Application.Max(Cells(r,9).Value, m)
といった感じで良いものと考えられます。

最初に値をセットする時は前半の代入を、既に値が入力されているなら後半の比較結果を代入するようにすればよろしいかと思います。

めぐみん_ · Answer

No.2です。

私も他回答者さんと同じ意見として、現在の作業手順について気にはなります。
特に私が気にしているのは、『セルの選択をする際に Ctrlキーを用いて複数行含め纏めて Selection としているのかどうか』ですね。
逆に私が同じ作業をしてたとしたら１個ずつ選択してって事は手間になると考えて、それを効率化する方法をまずは検討すると思うからです。

めぐみん_ · Answer

No.5です。

＞Re = RefEdit1.Value

ここがちょっと気にはなるのですが。
次に変数：Re は For Each の受け手になってますので、その前に値を代入してもどうなのかなって。
私個人は描画については今のコードで良いとは思います。
あとは既に回答してきた内容をここに組み込んでみる検証を進めたいと思いますが、他に良い回答が付きましたらそちらで質問を閉じて頂いても構いませんので。

めぐみん_ · Answer

No.5,6です。

No.5のお礼にあるコードで描画できたのですよね？
こちらでは RefEdit1.Value で得た範囲は無視されました。
このコードはユーザーフォームモジュールで例えばコマンドボタンを押した時にって事なら、

Private Sub CommandButton1_Click()
Dim Re As Range
'Re = RefEdit1.Value
For Each Re In Range(RefEdit1.Value).Areas '取得したセル範囲を固まり毎に分割(Areas)してます。
With ActiveSheet.Shapes.AddLine(Re.Left, Re.Top + Re.Height / 2, Re.Left + Re.Width, Re.Top + Re.Height / 2).Line
.ForeColor.RGB = RGB(0, 0, 0)
.Style = 1
.BeginArrowheadStyle = 1
.EndArrowheadStyle = 3
.Weight = 1
.DashStyle = msoLineDash
End With
Next Re
End Sub

こちらでなら選択した（Ctrlキー使用）セル範囲に矢印はつきました。
本題についてはまだ検証中ですけど。

めぐみん_ · Answer

No.7です。

ちょっと悩んでいることがありまして。

矢印を既に存在している行に追加するのは良いのですが、予定変更による移動・削除が行われるのか？と言う所ですね。
移動については一旦矢印を消してもらって改めてセル範囲を選択するなら回避できるかもですが、削除につきましてはそれに伴う日付変更が思いつかないです。
これらの作業ってあるのでしょうか？

めぐみん_ · Answer

途中で一息つくのはご勘弁。

＞あともう一つしたいのが現状は開始日も終了日も”数値にて取得しているため

こちらについては該当セルに日付を入れて頂き、セルの書式設定で”日”又は”月日”になるようにしておけば宜しいのでは？
例えば６行目をそのようにされたとしても、同時に開始日・終了日も日付として扱い不都合がなければ書き加える際に”日”だけの数値にも出来ますし、セルの書式設定を事前に１０行目以下に当てはめておけば日付での比較・書き込みは可能でしょう。（そこはまだ検証段階には至ってませんけど）

Excel VBA ｵｰﾄｼｪｲﾌﾟ上のｾﾙ位置取得後、そのｾﾙ位置の日付を取得する方法について

こんばんは

＞矢印線挿入はﾏｸﾛにてｱｸﾃｨﾌﾞｾﾙに挿入していますので

No1です

No3です

No.2です。

No.5です。

No.5,6です。

No.7です。

途中で一息つくのはご勘弁。

こんな感じですかね。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング