| |
下記プログラムで、１列目に行を挿入した場合に問題なく線を引くためには、どこを変更したらいいでしょうか？
------------------------------------------------------------------
------------------------------------------------------------------
このようなシートで、B列に入れた数だけ、C列以降に線を引きます。
A B C D E F G H I
1 開始日 日数 5月1日 5月2日 5月3日 5月4日 5月5日 5月6日 5月7日
2 5月1日 2 -------------
3 5月3日 4 ----------------------------
4 5月7日 1 ------
5 5月2日 5 ------------------------------------
6 5月4日 3 ---------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer, j As Long, futosa As Variant, LastCol As Integer, k As Integer
Dim s As Shape, wLeft, wTop, wRight, wBottom
Dim shapeLeft, shapeTop, shapeRight, shapeBottom
Dim iroNO As String, iro As Variant
On Error GoTo trap
i = Target.Value
j = Target.Row
If Target.Column <> 2 Or j = 1 Or i <= 0 Or i > 31 Then
Exit Sub
End If
With Application
Do
futosa = .InputBox("太さを指定してください？", "整数入力", 5, Type:=1)
If VarType(futosa) = vbBoolean Then
.EnableEvents = False
.Undo
.EnableEvents = True
Exit Sub
End If
If futosa > 0 Then
If futosa <= Target.Height Then
Exit Do
Else
MsgBox "セルの縦幅よりも太いです。もう少し細い線を指定してください"
End If
End If
Loop
iroNO = " 8）黒 9）白 10）赤 11）黄緑" & vbCrLf & "12）青 13)黄 14）ピンク 15）水色"
Do
iro = .InputBox("線の色は、何番にしますか？" & vbCrLf & iroNO, "線の色指定", 8, Type:=1)
If VarType(iro) = vbBoolean Then
.EnableEvents = False
.Undo
.EnableEvents = True
Exit Sub
End If
Select Case iro
Case 8 To 15
Exit Do
End Select
Loop
End With
With Rows(j)
wTop = .Top
wLeft = .Left
wBottom = .Top + .Height
wRight = .Left + .Width
End With
For Each s In ActiveSheet.Shapes
shapeTop = s.Top
shapeLeft = s.Left
shapeBottom = s.Top + s.Height
shapeRight = s.Left + s.Width
If wTop <= shapeTop And wLeft <= shapeLeft And _
wBottom >= shapeBottom And wRight >= shapeRight Then
s.Delete
End If
Next
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
For k = 3 To LastCol
If Target.Offset(0, -1).Value = Cells(1, k) Then
With ActiveSheet.Shapes.AddLine(Cells(j, k).Left, Target.Top + Target.Height / 2, _
Cells(j, k + i).Left, Target.Top + Target.Height / 2).Line
.Weight = futosa
.ForeColor.SchemeColor = iro
End With
Exit For
End If
Next
Target.Select
trap:
End Sub
|
|
Ju-
- 06/3/3(金) 23:26 -
