人に聞けない痔の悩み、これでスッキリ >>

今月入ってVBAの勉強を始めた者です。
勉強にと、webで見つけた工程表のコードを読みながら作りたいモノへ改良しようとおもったのですがうまく行きません。
C列:開始日 D列:終了日
E2~月
E3~日
E4~曜日
E5~オートシェイプ描画欄
開始日と終了日を入力すると矢印が作成・変更される。
という仕様になっていますが、1日からの開始だと矢印が2日多く先まで矢印が引かれてしまい、終了日がズレてしまいます。2日以降の開始日であればズレないのですが、どこを直したらよいでしょうか。
 また、表の最終列が変化するのですが、ForNext関数を使用する際、その変化に対応させたいのですがどのようにしたらよいでしょう。

コードは下記の様です。宜しくお願い致します。

Private Sub Worksheet_SelectionChange(ByVal target As Range)

' 工程ライン作成
Const ORG_DATE As Date = #4/1/2012# '開始年月日
Dim myDate As Date '処理中の日付を表す変数
Dim X1 As Single
Dim Y1 As Single
Dim X2 As Single
Dim Y2 As Single
Dim kiten As Range
Dim Kikan As Long
Dim Start As Long
Dim i As Long

If target.Column = Range("C:D").Column Then

myDate = ORG_DATE

On Error Resume Next
For i = 5 To 30
ActiveSheet.Shapes("KOUTEIline " & i).Delete
Next i

For i = 5 To 30
Start = Cells(i, 3).Value - myDate
Kikan = Cells(i, 4).Value - Cells(i, 3).Value

X1 = Range(Cells(1, 1), Cells(1, 4 + Start)).Width
Y1 = Range(Cells(1, 1), Cells(i - 1, 1)).Height + Cells(i, 1).Height / 2
X2 = X1 + Range(Cells(i, 4 + Start), Cells(i, Start + 4 + Kikan)).Width
Y2 = Y1

With ActiveSheet.Shapes.AddLine(X1, Y1, X2, Y2)
.Name = "KOUTEIline " & i
.Line.EndArrowheadStyle = msoArrowheadTriangle
.Line.Interior.Color = vbRed
.Line.Weight = 4
End With

Next i
End If

End Sub

このQ&Aに関連する最新のQ&A

A 回答 (1件)

確認していないけど、



X2 = X1 + Range(Cells(i, 4 + Start), Cells(i, Start + 4 + Kikan)).Width

X2 = Range(Cells(1, 1), Cells(1, Start + 5 + Kikan)).Width

とすればいいんじゃないかな。
    • good
    • 0
この回答へのお礼

おっしゃるとおりでした。
ありがとうございます( ^^*)

お礼日時:2012/03/20 00:21

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QExcel VBA で自在に図形を変化させたい

Excel VBAを使って図形を自由に変化させたいと思っています。

一つの形の四角形や三角形をVBAを使ってシート上に表記することは出来ます。

私はユーザーインターフェースを作り、テキストボックスに値を入れることで図形を変化させることをしたいと思っています。

例えば、一つの三角形を正三角形にしたり、直角二等辺三角形にしたり、自在に角度を変えてVBAに描かせたいと思っています。

三角形は以下のようにコードを記述しましたらシートに表示できました。

Sub 三角形作成()

Set ArwLine = ActiveSheet.Shapes.AddLine(10, 10, 200, 200)
Set ArwLine = ActiveSheet.Shapes.AddLine(200, 200, 100, 400)
Set ArwLine = ActiveSheet.Shapes.AddLine(100, 400, 10, 10)

End Sub

これを以下のようにして変数(x、y)にユーザーインターファースから値を代入するようにしたいのですがどのようにすればよいのでしょうか教えてください。

Private Sub CommandButton1_Click()
UserForm1.Show

End Sub

Sub 三角形作成()

Set ArwLine = ActiveSheet.Shapes.AddLine(10, 10, 200, 200)
Set ArwLine = ActiveSheet.Shapes.AddLine(200, 200, x, y)
Set ArwLine = ActiveSheet.Shapes.AddLine(x, y, 10, 10)

End Sub

前回、「Excel VBAで図面を書きたい」という質問をしたのですがややこしく書いたため解答される方が居ませんでしたので編集して再質問をさせていただきます。
よろしくお願いします。

Excel VBAを使って図形を自由に変化させたいと思っています。

一つの形の四角形や三角形をVBAを使ってシート上に表記することは出来ます。

私はユーザーインターフェースを作り、テキストボックスに値を入れることで図形を変化させることをしたいと思っています。

例えば、一つの三角形を正三角形にしたり、直角二等辺三角形にしたり、自在に角度を変えてVBAに描かせたいと思っています。

三角形は以下のようにコードを記述しましたらシートに表示できました。

Sub 三角形作成()

Set ArwLine ...続きを読む

Aベストアンサー

VBAで出来ると思いますし、もちろん他の言語でも可能でしょう。
質問で書かれたコード「Sub 三角形作成()」で kakusan_t さん自身が既に三角形を描画してますよね?
あとは辺の長さや角度を指定するたびに、以前の図形を消してから三角形を書き直せば良いだけです。

ただ、角度が1度かわる毎に終点の座標をどれだけずらせば良いかなど、コンピューター上で座標に置き換える計算式を作る知識が必要で、これが簡単ではないと思います。(数学の知識がある方なら簡単かも知れませんけど)
本にずばりの例文があるようなものでは無いと思いますよ。

ちなみに
1.新規にExcelを開く
2.VB Editorを開く
3.VBE画面の挿入-ユーザーフォームでUserFormを作り、TextBoxを2つと、CommandButtonを1つ置く
4.CommandButtonをダブルクリックして下記をコピペ

'-----------------------------------------------------------------------------
Private Sub CommandButton1_Click()
Dim x As Single, y As Single, sh As Shape
 On Error Resume Next
 x = CSng(TextBox1.Value)
 y = CSng(TextBox2.Value)
 With ActiveSheet
  For Each sh In .Shapes
    sh.Delete
  Next sh
  .Shapes.AddLine 10, 10, 200, 200
  .Shapes.AddLine 200, 200, x, y
  .Shapes.AddLine x, y, 10, 10
 End With
End Sub
'-----------------------------------------------------------------------------

5.VBE画面の挿入-標準モジュールでModule1が追加されるので、下記をコピペ

'-----------------------------------------------------------------------------
Sub Test()
  UserForm1.Show
End Sub
'-----------------------------------------------------------------------------

6.Excelに戻りツール→マクロ実行→Testを実行

VBAで出来ると思いますし、もちろん他の言語でも可能でしょう。
質問で書かれたコード「Sub 三角形作成()」で kakusan_t さん自身が既に三角形を描画してますよね?
あとは辺の長さや角度を指定するたびに、以前の図形を消してから三角形を書き直せば良いだけです。

ただ、角度が1度かわる毎に終点の座標をどれだけずらせば良いかなど、コンピューター上で座標に置き換える計算式を作る知識が必要で、これが簡単ではないと思います。(数学の知識がある方なら簡単かも知れませんけど)
本にずばりの例文が...続きを読む

QエクセルVBAで画像を貼り付ける座標設定方法は?

Sheets("Sheet1")に貼り付けたJ-pegの画像(=シンボルマーク)を別なシートに貼り付けるのは下記のVBAで出来ました。ただ、これでは貼り付け先のシートのセルK12が、貼り付け元のK12と同じ位置でないと思った場所に張り付きません。
そこでセルで場所を指定するのではなく、座標のようなもので指定する方法はないものかと考えた次第です。
オートシェイプなどは座標指定で作成できるのですが、J-pegのような画像はどうすればいいのでしょうか?

Sub TEST()
Sheets("FACE").Shapes("シンボルマーク").Copy
ActiveSheet.Range("K12").Select
ActiveSheet.Paste
End Sub

Aベストアンサー

#1です。
>この場合、ファイルをエクセルにくっつけて渡すなんてこと
>はできないものでしょうか?(別々にではなくあくまでエク
>セルのブックに付属した形で)
Excelのブックに付属した形にするなら、コピーペーストする方がいいと思います。一旦挿入した画像を別途保存するのは、簡単には出来ないと思います。

複数のシートで同じような作業をするなら、次のような方法も考えられます。
Function CpyMrk(MrkNM As String, myTop As Single, myLeft As Single)
Sheets("FACE").Shapes(MrkNM).Copy
ActiveSheet.Paste
ActiveSheet.Shapes(MrkNM).Top = myTop
ActiveSheet.Shapes(MrkNM).Left = myLeft
End Function

Sub test()
CpyMrk "シンボルマーク", 10, 10
End Sub

QエクセルVBAですが教えてください。オートシェイプがコピーされません。

またまたお世話になります。「入力」シートから「コピー先」シート
にコピーして貼付したいのですが、コードで記述してうまくいき
ません。すごく簡単なことかと思いますが、まったく解決できず
にいます。何か足りないのでしょうか?よろしくご指導ください。


Sheets("入力").Select
Range("A1:V20").Copy
Sheets("コピー先").Range("A22").PasteSpecial Paste:=xlAll
Application.CutCopyMode = False

Aベストアンサー

こんなのは:

Sheets("入力").Range("A1:V20").Copy
with Sheets("コピー先")
.Select
.Range("A22").Select
.Paste
end with

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。


人気Q&Aランキング