※上記の広告は60日以上更新のないWIKIに表示されています。更新することで広告が下部へ移動します。

AccessVBAからExcelWorkBookを新規作成・保存する


  • ソース

' CreateNewExcelBook
' AccessVBAからExcelのWorkbookを新規作成・保存する
' 引数:あり
' iTemplatePath :テンプレートファイルのフルパス
' 戻り値:保存したファイルのフルパス
Public Function CreateNewExcelBook(ByVal iTemplatePath As String) As String
    Dim xlsAppli As Object
    Dim xlsWb As Object
    Dim xlsFile As String
    Dim resultFilePath As String
    
    resultFilePath = ""
    
    ' excelファイル作成
    Set xlsAppli = CreateObject("Excel.Application")
    
    If Len(iTemplatePath) > 0 And Dir(iTemplatePath) <> "" Then
        Set xlsWb = xlsAppli.Workbooks.Add(iTemplatePath)
    Else
        Set xlsWb = xlsAppli.Workbooks.Add
    End If
    ' excelを可視状態にする
    ' ※不可視状態での事故防止
    xlsAppli.Visible = True
    
    ' 保存ダイアログを表示
    xlsFile = xlsAppli.GetSaveAsFilename(InitialFileName:="保存ファイル名を入力してください.xls", _
                                        Title:="保存先・保存ファイル名を指定してください")
    If xlsFile <> "False" Then
        ' Excelのバージョンが2007以降で、保存ファイル名の拡張子が「.xls」(2003以前)の場合
        If xlsAppli.Version >= 12 And Right(xlsFile, 4) = ".xls" Then
            Call xlsWb.SaveAs(fileName:=xlsFile, FileFormat:=56)
        ' Excelのバージョンが2007以降で、保存ファイル名の拡張子が「.xls」(2003以前)以外の場合
        ElseIf xlsAppli.Version >= 12 Then
            Call xlsWb.SaveAs(fileName:=xlsFile, FileFormat:=51)
        ' Excelのバージョンが2003以前の場合
        Else
            Call xlsWb.SaveAs(fileName:=xlsFile)
        End If
        resultFilePath = xlsFile
    End If
    
    CreateNewExcelBook = resultFilePath
End Function