| |
検証したり中身を書いたりしてる間にすれ違ってすみません。
無事動きました。
一回全部窓を閉じて動かしたら今度は無事マクロまで動いたので、
何かが影響していたのかもしれませんね。
成功したマクロとVBSを記入しておきます。
長らくお付き合いいただいて本当にありがとうございました。
しかし…アドインがエラー起こしたり起こさなかったりは何が影響するんでしょうね…。
[VBS側]
Option Explicit
Const cnsBook = "c:\test.xls"
Const strProcName = "before"
dim xlApp,xlBook
Set xlApp = CreateObject("Excel.Application")
' 本スクリプトファイルのフォルダ名の取得
'アドインリフレッシュ
Call AddinRefresh(xlApp,"分析ツール")
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Open(cnsBook, False, True)
xlApp.Run strProcName
Set xlBook = Nothing
Set xlApp = Nothing
Private Sub AddinRefresh(inXlsApp,inAddinName)
On Error Resume Next
inXlsApp.AddIns(inAddinName).Installed = False
inXlsApp.AddIns(inAddinName).Installed = True
End Sub
[VBA側]
Sub Before()
Dim ws0 As String
Dim ws1 As Worksheet, ws2 As Worksheet
Dim i As Long, k As Long
Dim date1 As Date, date2 As Date
ws0 = Format$(Date, "yyyyMM")
Set ws1 = ThisWorkbook.Worksheets(ws0)
Set ws2 = ThisWorkbook.Worksheets("日付")
date1 = ws2.Range("D2").Value
date2 = ws2.Range("D3").Value
'------ここから------
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
If ws1.Cells(i, 1) > date1 And ws1.Cells(i, 1) < date2 Then
MsgBox ws1.Cells(i, 1).Value
End If
Next i
For k = 1 To Range("b" & Rows.Count).End(xlUp).Row
If ws1.Cells(k, 2) > date1 And ws1.Cells(k, 2) < date2 Then
MsgBox ws1.Cells(k, 2).Value
End If
Next k
'------ここまで------
End Sub
'------ここから------
Dim c As Range
For Each c In ws1.Range("A1", ws1.Cells(ws1.Rows.Count, 1).End(xlUp))
Select Case c.Value
Case date1 To date2
MsgBox c.Value
End Select
Next
'------ここまで------
ここから-ここまではどちらのパターンでも動きました。
|
|
さくら
- 09/7/6(月) 16:54 -
