ITシステム・ソフト関連  

関連広告

IT関連ページの移動


3.コード紹介 (2)


<03: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


About Us | Site Map | Privacy Policy | Contact Us | © 2003-2007 Copyright (c) LaFraise.netR All Rights Reserved.