エクスポート ( Excel )

  API 定義



  
' ******************************************************
' OPENFILENAME 構造体
' ******************************************************
Type OPENFILENAME
        lStructSize As Long         ' 76
        hwndOwner As Long
        hInstance As Long
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
End Type

' ******************************************************
' 保存する
' ******************************************************
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" ( _
    pOpenfilename As OPENFILENAME _
) As Long

Global Const OFN_READONLY = &H1
Global Const OFN_OVERWRITEPROMPT = &H2
Global Const OFN_HIDEREADONLY = &H4
Global Const OFN_NOCHANGEDIR = &H8
Global Const OFN_SHOWHELP = &H10
Global Const OFN_ENABLEHOOK = &H20
Global Const OFN_ENABLETEMPLATE = &H40
Global Const OFN_ENABLETEMPLATEHANDLE = &H80
Global Const OFN_NOVALIDATE = &H100
Global Const OFN_ALLOWMULTISELECT = &H200
Global Const OFN_EXTENSIONDIFFERENT = &H400
Global Const OFN_PATHMUSTEXIST = &H800
Global Const OFN_FILEMUSTEXIST = &H1000
Global Const OFN_CREATEPROMPT = &H2000
Global Const OFN_SHAREAWARE = &H4000
Global Const OFN_NOREADONLYRETURN = &H8000
Global Const OFN_NOTESTFILECREATE = &H10000
Global Const OFN_NONETWORKBUTTON = &H20000
Global Const OFN_NOLONGNAMES = &H40000
Global Const OFN_EXPLORER = &H80000
Global Const OFN_NODEREFERENCELINKS = &H100000
Global Const OFN_LONGNAMES = &H200000
  

  
' ******************************************************
' ファイルを保存するダイアログ
' ******************************************************
Public Function SaveFileDlg( _
    strTitle As String, _
    hOwner As Long, _
    strFilter As String, _
    nCutFilterIndex As Long, _
    strPath As String _
) As Boolean

    Dim ofn As OPENFILENAME
    Dim ret As Long
    Dim strFilePath As String * 512
    Dim strFilterWork As Variant
    Dim I As Integer

    If strPath <> "" Then
        strFilePath = strPath & String(512, Chr(0))
    End If

    ofn.lStructSize = LenB(ofn)
    ofn.hwndOwner = hOwner
    strFilterWork = Split(strFilter, ",")
    ofn.lpstrFilter = ""
    For I = 0 To UBound(strFilterWork)
        ofn.lpstrFilter = ofn.lpstrFilter & strFilterWork(I) & Chr(0)
    Next
    ofn.lpstrFilter = ofn.lpstrFilter & Chr(0)
    ofn.nFilterIndex = nCutFilterIndex
    ofn.lpstrFile = strFilePath
    ofn.nMaxFile = 512
    ofn.lpstrTitle = strTitle
    ofn.flags = OFN_HIDEREADONLY
    ret = GetSaveFileName(ofn)
    If ret <> 0 Then
        SaveFileDlg = True
        strPath = Left(ofn.lpstrFile, InStr(ofn.lpstrFile, Chr(0)) - 1)
    Else
        SaveFileDlg = False
    End If

End Function


  



  エクスポート



  
    Dim strFilePath As String
    
    If SaveFileDlg( _
            "Excel へエクスポート", _
            Me.Hwnd, _
            "Excel8,*.xls,全て,*.*", _
            1, _
            strFilePath _
        ) Then
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "T_マスタ", strFilePath
    End If
  










  infoboard   管理者用   
このエントリーをはてなブックマークに追加





フリーフォントWEBサービス
SQLの窓WEBサービス

SQLの窓フリーソフト

素材

一般WEBツールリンク

SQLの窓

フリーソフト

JSライブラリ