WebのUIを変更。

選択をラジオボタンにして、入力フォームの文字を大きくした。

Excel側の日付ダイアログをもっとアプリっぽくして、

日付の間でデータが無いとグラフが切れちゃってたので、

VBAを修正し、データが存在してる点をつなぐようにした。(o^-‘)b グッ!

が、

Excel終了時に必ずエラーになる・・・

COM参照中にVBAが動くからかなぁ？

COMの解放関係ではなさそうだが。解らん┐(´д｀)┌

VBAはこんなだけど、

[vb]
Public Sub WorksheetChange(ByVal Target As Range)
If Target.Row = Range("_C_MAX1").Row Or Target.Row = Range("_C_MIN1").Row Then
Dim nm As String
Dim nm1 As String
Dim nm2 As String
If Target.Row = Range("_C_MAX1").Row Then
nm = "MAX" & Target.Column
nm1 = SearchShape("MAX", Target.Column, 1, Target.Parent)
nm2 = SearchShape("MAX", Target.Column, -1, Target.Parent)
End If
If Target.Row = Range("_C_MIN1").Row Then
nm = "MIN" & Target.Column
nm1 = SearchShape("MIN", Target.Column, 1, Target.Parent)
nm2 = SearchShape("MIN", Target.Column, -1, Target.Parent)
End If

line1 = nm & "-" & nm1
line2 = nm2 & "-" & nm
If nm <> "" Then Call DelShape(nm, Target.Parent)
If nm <> "" Then Call DelShapeLine("-" & nm, Target.Parent)
If nm <> "" Then Call DelShapeLine(nm & "-", Target.Parent)
If nm1 <> "" Then Call DelShapeLine("-" & nm1, Target.Parent)
If nm2 <> "" Then Call DelShapeLine(nm2 & "-", Target.Parent)

If nm <> "" Then
If IsNumeric(Target.Value) = True Then
Call AddOval(Target, nm, 2, Target.Parent)
Call AddLine(nm, nm1, nm2, Target.Parent)
Else
Call AddLine(nm2, nm1, "", Target.Parent)
End If
End If
End If

End Sub

Public Function SearchShape(ByVal str As String, ByVal col As Long, ByVal direction As Integer, ByRef sheet As Worksheet) As String
Dim nm As String
Dim b As Boolean
b = False
For i = 2 To 10 Step 2
nm = str & (col + i * direction)
For Each a In sheet.Shapes
If a.Name = nm Then
b = True
Exit For
End If
Next a
If b = True Then Exit For
Next i
If b = False Then
nm = ""
End If
SearchShape = nm
End Function

Public Sub AddOval(ByVal Target As Range, ByVal nm As String, ByVal fos As Long, ByRef sheet As Worksheet)
ofs = (Range("42:42").Top – Range("12:12").Top) / 150
colPos = Target.Cells(1, fos).Left – 2
rowPos = Range("42:42").Top – (Target.Value – 50) * ofs – 2
With sheet.Shapes.AddShape(msoShapeOval, colPos, _
rowPos, 4, 4)
.Name = nm
.ZOrder (msoBringToFront)
End With
End Sub

Public Sub DelShape(ByVal nm As String, ByRef sheet As Worksheet)
For Each a In sheet.Shapes
If a.Name = nm Then
a.Delete
End If
Next a
End Sub

Public Sub DelShapeLine(ByVal nm As String, ByRef sheet As Worksheet)
For Each a In sheet.Shapes
If a.Name Like nm & "*" Or a.Name Like "*" & nm Then
a.Delete
End If
Next a
End Sub

Public Sub AddLine(ByVal nm As String, ByVal nm1 As String, ByVal nm2 As String, ByRef sheet As Worksheet)

b = False
b1 = False
b2 = False
Dim sh As Shape
Dim sh1 As Shape
Dim sh2 As Shape

For Each a In sheet.Shapes
If a.Name = nm Then
Set sh = a
b = True
End If
Next a
For Each a In sheet.Shapes
If a.Name = nm1 Then
Set sh1 = a
b1 = True
End If
Next a
For Each a In sheet.Shapes
If a.Name = nm2 Then
Set sh2 = a
b2 = True
End If
Next a

‘ 次のOvalへ線を引く
If b = True And b1 = True Then
line1 = nm & "-" & nm1
With sheet.Shapes.AddLine(sh.Left + 2, sh.Top + 2, sh1.Left + 2, sh1.Top + 2)
.Name = line1
.Line.Weight = 2
.ZOrder msoSendToBack
End With
End If
‘ 前のOvalへ線を引く
If b = True And b2 = True Then
line2 = nm2 & "-" & nm
With sheet.Shapes.AddLine(sh.Left + 2, sh.Top + 2, sh2.Left + 2, sh2.Top + 2)
.Name = line2
.Line.Weight = 2
.ZOrder msoSendToBack
End With
End If
End Sub
[/vb]

さてどこがイカんのだ。それともVSTO側なのか。