'######################################################################## '初期化処理 '######################################################################## Private Sub Initialize() Call SetExlObject End Sub
'######################################################################## 'ボタンを押すとCSVファイルにデーターを書き込む '######################################################################## Private Sub btn_Create_data_Clickr() Dim ExpFile As String Dim ExpPath As String Dim ExpFileName As String Dim ExpDRange As String Dim srcWS As Worksheet Dim srcWB As Workbook Dim tgtWB As Workbook Dim blFopen As Boolean
'CSVファイルが開いていなければ、ファイルのオブジェクト取得 If tgtWB Is Nothing Then Set srcWB = objExl.Workbooks.Open(ExpFileName) 'CSV開いていれば、開いているファイルのオブジェクトを取得 Else Set srcWB = tgtWB blFopen = True End If
'ワークシートの取得 Set srcWS = srcWB.Worksheets(1)
'データーの初期化処理 初めてファイルを開いた時 If blFopen = False Then Call AllClear_Data(srcWS, ExpFile, ExpDRange) End If
'データー書き込み処理 Call WriteData(srcWS)
On Error GoTo Exception srcWB.Save Exception: 'MsgBox Err.Number & "/" & Err.Description Exit Sub End Sub
'######################################################################## '指定のExcelファイルがある場合はオブジェクトを返し、無ければNothingを返す '######################################################################## Private Function getWorkbookByName(targetWorkbookName) As Workbook Dim TempWorkbook As Workbook For Each TempWorkbook In objExl.Workbooks If TempWorkbook.Name = targetWorkbookName Then Set getWorkbookByName = TempWorkbook Exit Function End If Next
Set getWorkbookByName = Nothing End Function
'######################################################################## 'Excel Application の Object を作成する '######################################################################## Private Sub SetExlObject() On Error Resume Next
If Err.Number > 0 Then Set objExl = CreateObject("Excel.Application") Err.Clear End If
objExl.Visible = True objExl.UserControl = True
End Sub
'######################################################################## 'データー書き込み処理 '######################################################################## Private Sub WriteData(aWS As Object) Dim lastrow As String
With aWS nextrow = .Range("A" & 1000).End(xlUp).Row + 1
'######################################################################## '指定のExcelファイルがある場合はオブジェクトを返し、無ければNothingを返す '######################################################################## Private Function getWorkbookByName(targetWorkbookName) As Workbook Dim TempWorkbook As Workbook For Each TempWorkbook In objExl.Workbooks If TempWorkbook.Name = targetWorkbookName Then Set getWorkbookByName = TempWorkbook Exit Function End If Next
'CSVファイルが開いていなければ、ファイルのオブジェクト取得 If tgtWB Is Nothing Then Set srcWB = objExl.Workbooks.Open(ExpFileName) 'CSV開いていれば、開いているファイルのオブジェクトを取得 Else Set srcWB = tgtWB blFopen = True End If
'ワークシートの取得 Set srcWS = srcWB.Worksheets(1)
最後は、ファイルデーター作成処理をして保存ですが、ここでエラーが発生してしまいました!
エラーコードは出てこないので、内容はわかりませんが、エラーとして取り扱われているようです。
ここは、強引な力技で、エラーをキャッチして何もしないという処理で乗り切りました!
このエラーが何なのかは追求しませんでした。
'データーの初期化処理 初めてファイルを開いた時 If blFopen = False Then Call AllClear_Data(srcWS, ExpFile, ExpDRange) End If
'データー書き込み処理 Call WriteData(srcWS)
On Error GoTo Exception srcWB.Save Exception: 'MsgBox Err.Number & "/" & Err.Description Exit Sub End Sub