ITシステム関連

３．コード紹介　(2)

＜０３：Excel操作＞

　・ExcelをVBコードで操作する手順を紹介します。

　　'(1). **** Excelファイルオープン ********************
　　 Public Function FUNCopenExcel$(pstrFileName$, _
　　　　　　　　　　　　　　　　　　Optional pblnSW As Boolean = True)
　　 On Error GoTo LABEL_Err
　　 Dim strResult$
　　　
　　 　Set gxlsApp = CreateObject(gcstrExcelApp$)
　　　 gxlsApp.Workbooks.Open pstrFileName$ 'ﾌｧｲﾙ･ｵｰﾌﾟﾝ
　　　 gxlsApp.Visible = pblnSW 'Excelを可視にする
　　　
　　 LABEL_Exit:
　　 　FUNCopenExcel$ = strResult$
　　 　Exit Function
　　 LABEL_Err:
　　　 strResult$ = Err.Number & " : " & Err.Description
　　　 Resume LABEL_Exit
　　 End Function
　　　
　　　
　　'(2). **** Excelファイルクローズ ********************
　　 Public Function FUNCcloseExcel$()
　　 On Error Resume Next
　　 Dim strResult$
　　　
　　 　gxlsApp.ActiveWorkbook.Close (False) 'False=保存せず
　　 　gxlsApp.Quit '終了
　　 　On Error GoTo LABEL_Err
　　　 Set gxlsApp = Nothing
　　　
　　 LABEL_Exit:
FUNCcloseExcel$ = strResult$: Exit Function
　　 LABEL_Err:
　　　　If Err.Number <> 91 Then _
　　　　　strResult$ = Err.Number & " : " & Err.Description
　　　　　strResult$ = Err.Number & " : " & Err.Description
　　 Resume LABEL_Exit
　　 End Function
　　'(3). Func: Execlにﾃｰﾌﾞﾙをｴｸｽﾎﾟｰﾄ(OLE ｵｰﾄﾒｰｼｮﾝ) **********************
Private Sub OLEExcelDisp(pstrTableName$)
Dim strFileName$
Const mstrExcelApp$ = "Excel.Application"
On Error GoTo LABEL_Err

Err.Clear
'�@ﾃｰﾌﾞﾙ名からExcelﾌｧｧｲﾙ名を作成
strFileName$ = gstrCurrentPath$ & pstrTableName$ & ".xls" '現在のパス＋Excelﾌｧｲﾙ名
'�B古いﾌｧｲﾙを一旦削除
On Error GoTo LABEL_Err
'Declare Dim colFileSystem As Object
Dim objFile As Object
'FileSystemObject用意
Set colFileSystem = CreateObject("Scripting.FileSystemObject")
'削除処理
On Error Resume Next 'まだ一度も「WEB_得意先別機種情報マスタ.xls」
Set objFile = colFileSystem.GetFile(strFileName$) 'を作成したことがないときは削除しようとすると
objFile.Delete 'エラーになる。このときは、ｴﾗｰを無視して次に
'ﾒﾓﾘから開放 '進む。
On Error GoTo LABEL_Err
Set colFileSystem = Nothing
Set objFile = Nothing
'�Aすでに開かれていないか確認
Dim objExcel As Object
Dim blmFlag As Boolean
On Error Resume Next
Set objExcel = GetObject(strFileName$)
If Err.Number = 0 Then
objExcel.Close
blmFlag = True
End If
'MsgBox Err.Number & " : " & Err.Description 'for Debug
If Not (Err.Number = 0) Or blmFlag Then 'まだ Excelｼｰﾄが開かれていないとき
'�Bﾃｰﾌﾞﾙからｴｸｽﾎﾟｰﾄ
'ｴｸｽﾎﾟｰﾄ実施
DoCmd.TransferSpreadsheet acExport, _
acSpreadsheetTypeExcel9, _
pstrTableName$, _
strFileName$, _
True
'�COLEｵｰﾄﾒｰｼｮﾝでExcelﾌｧｲﾙを開く
'Declare Dim objExcelBook As Object
'Late Binding 方式で Excelのｲﾝｽﾀﾝｽを作成(New を使ったEarlyBindingは推奨されていないらしい)
Set objExcel = CreateObject(gcstrExcelApp$)
'ﾌｧｲﾙ･ｵｰﾌﾟﾝ
objExcel.workbooks.Open strFileName$
'Excelを可視にする
objExcel.Visible = True
'objExcel.Quit
'ﾒﾓﾘから開放
Set objExcelBook = Nothing
Else
MsgBox "すでに開かれています", vbInformation, " Excel "
End If
Set objExcel = Nothing

LABEL_Exit:
Exit Sub
LABEL_Err:
MsgBox Err.Number & " : " & Err.Description
Resume LABEL_Exit
End Sub