| |
▼サチチ さん：
こんにちは。
>・名前は、名前をつけて保存の様にしたいのです。(自分の好きな名前)
ちょっとこちらに苦労していたのですが、
Excelのファイルダイアログを使ってみました。
バージョン依存なので、うまく行かなかったら他のを考えてみます。
Private Sub Excel出力_Click()
'要参照 DAO x.x Object Library
Dim xlsApp As Object
Dim xlsWkb As Object
Dim xlsSht As Object
Dim QD As DAO.QueryDef
Dim RS As DAO.Recordset
Dim i As Long
Dim strField As String
Const QName = "クエリ3年"
Const Ex_msoFileDialogSaveAs = 2
If IsNull(Me.txt年) Then
MsgBox "年を入力してから実行してください。"
Exit Sub
End If
Set QD = CurrentDb.QueryDefs(QName)
QD.Parameters(0).Value = Me.txt年.Value
Set RS = QD.OpenRecordset
Set xlsApp = CreateObject("Excel.Application")
xlsApp.Visible = True
Set xlsWkb = xlsApp.Workbooks.Add
With xlsWkb.Sheets("sheet1")
For i = 1 To RS.Fields.Count
strField = RS(i - 1).Name
If InStr(1, strField, "年目") > 0 Then
strField = Me.txt年 + Val(strField) - 1 & "年"
End If
.Cells(1, i).Value = strField
Next
.Range("A2").CopyFromRecordset RS
End With
With xlsApp.FileDialog(Ex_msoFileDialogSaveAs)
.Show
If .SelectedItems.Count = 0 Then
xlsWkb.Saved = True
Else
xlsApp.DisplayAlerts = False
xlsWkb.SaveAs .SelectedItems(1)
xlsApp.DisplayAlerts = True
End If
End With
xlsWkb.Close: Set xlsWkb = Nothing
xlsApp.Quit: Set xlsApp = Nothing
RS.Close: Set RS = Nothing
QD.Close: Set QD = Nothing
End Sub
>Const QName = "クエリ3年"
の行は現在使用しているクエリの名前に変更して下さい。
>別で質問を出そうかと思っていたのですが、これもご一緒の質問でいいですか?
殆ど VBA で作成しているので、マクロは苦手だったりします^^;
>・出力ファイル＝D:\UserArea\デスクトップ\判定日付全てブランク.xls
> ↑
>これを、毎回好きな名前にしたいのです。
出力ファイルを指定する欄を空白にすると、
ファイルをどこに保存するかのダイアログが出現しますが、
そちらでは駄目なのでしょうか。
|
|
小僧
- 05/12/6(火) 13:24 -
