ken3memoの下書き日記

引用でコードを貼ってみる。

18:04 |

Private Sub コマンド0_Click()

On Error GoTo Err_コマンド0_Click

Dim oApp As Object 'Excelアプリの参照用

Dim strWORK As String '文字編集用のワーク変数

Dim i As Integer

Dim strMDBPATH As String 'MDBの保存場所、フォルダー・ディレクトリ

Dim strXLSFILE As String 'テンプレートファイルの名前、e:\xxx\yyyy\テンプレート.xls

'Accessの起動位置を取得 CurrentDb.NameにD:\xxxx\yyyy\zzz.mdbが入っている

strWORK = CurrentDb.Name

'後ろから１文字単位で￥を探す

For i = Len(strWORK) To 1 Step -1

If Mid(strWORK, i, 1) = "\" Then Exit For '￥だったら抜ける

Next i

'D:\xxxx\yyyy\zzz.mdb --> D:\xxxx\yyyy\ にする

strMDBPATH = Mid(strWORK, 1, i)

'Excelの元ファイルの名前を作成　D:\xxxx\yyyy\ ＋ テンプレート.xls

strXLSFILE = strMDBPATH & "テンプレート.xls"

'ファイルの存在をチェックする

If Dir(strXLSFILE) = "" Then

MsgBox strXLSFILE & " の存在を 確認して下さい"

Exit Sub 'エラーなので途中で抜ける

End If

Set oApp = CreateObject("Excel.Application")

oApp.Visible = True

'Only XL 97 supports UserControl Property

On Error Resume Next

oApp.UserControl = True

'テンプレートファイルを開く

oApp.Workbooks.Open Filename:=strXLSFILE

Exit_コマンド0_Click:

Exit Sub

Err_コマンド0_Click:

MsgBox Err.Description

Resume Exit_コマンド0_Click

End Sub

↑引用でコードを貼ってみた。

ツイートする

PRE の タグでソースを貼ってみた。

18:07 |

Private Sub コマンド0_Click()
On Error GoTo Err_コマンド0_Click

    Dim oApp As Object     'Excelアプリの参照用
    Dim strWORK As String  '文字編集用のワーク変数
    Dim i As Integer
    Dim strMDBPATH As String   'MDBの保存場所、フォルダー・ディレクトリ
    Dim strXLSFILE As String   'テンプレートファイルの名前、e:\xxx\yyyy\テンプレート.xls
    
    'Accessの起動位置を取得 CurrentDb.NameにD:\xxxx\yyyy\zzz.mdbが入っている
    strWORK = CurrentDb.Name
    
    '後ろから１文字単位で￥を探す
    For i = Len(strWORK) To 1 Step -1
        If Mid(strWORK, i, 1) = "\" Then Exit For  '￥だったら抜ける
    Next i
    
    'D:\xxxx\yyyy\zzz.mdb --> D:\xxxx\yyyy\ にする
    strMDBPATH = Mid(strWORK, 1, i)

    'Excelの元ファイルの名前を作成　D:\xxxx\yyyy\ ＋ テンプレート.xls
    strXLSFILE = strMDBPATH & "テンプレート.xls"
    
    'ファイルの存在をチェックする
    If Dir(strXLSFILE) = "" Then
        MsgBox strXLSFILE & " の存在を 確認して下さい"
        Exit Sub  'エラーなので途中で抜ける
    End If

    Set oApp = CreateObject("Excel.Application")
    oApp.Visible = True
    'Only XL 97 supports UserControl Property
    On Error Resume Next
    oApp.UserControl = True

    'テンプレートファイルを開く
    oApp.Workbooks.Open Filename:=strXLSFILE



Exit_コマンド0_Click:
    Exit Sub

Err_コマンド0_Click:
    MsgBox Err.Description
    Resume Exit_コマンド0_Click
    
End Sub

<pre>

・

　・

　・

</pre>

で、貼ってみた。

ツイートする