回答編集履歴

4

修正

2020/12/18 09:26

投稿

sazi
sazi

スコア25243

test CHANGED
@@ -76,7 +76,7 @@
76
76
 
77
77
  ```VBA
78
78
 
79
- Public Function MyFileDialog(pType, pTitle, Optional pFileterTitle, Optional pFileter, Optional pPath) As String
79
+ Public Function MyFileDialog(pType, pTitle, Optional pFileterTitle, Optional pFileter, Optional pPath="") As String
80
80
 
81
81
  Dim wGetFileName
82
82
 

3

追記

2020/12/18 09:26

投稿

sazi
sazi

スコア25243

test CHANGED
@@ -71,3 +71,79 @@
71
71
  End Sub
72
72
 
73
73
  ```
74
+
75
+ フォルダ選択だったようなので、自作のFunctionを提供しておきます。
76
+
77
+ ```VBA
78
+
79
+ Public Function MyFileDialog(pType, pTitle, Optional pFileterTitle, Optional pFileter, Optional pPath) As String
80
+
81
+ Dim wGetFileName
82
+
83
+ wGetFileName = ""
84
+
85
+ With Application.FileDialog(pType)
86
+
87
+ 'ダイアログのタイトルを設定
88
+
89
+ .title = pTitle
90
+
91
+ If pType = 3 Then
92
+
93
+ 'ファイルの種類を設定
94
+
95
+ .Filters.Clear
96
+
97
+ .Filters.Add pFileterTitle, pFileter
98
+
99
+ .FilterIndex = 1
100
+
101
+ '複数ファイル選択を許可しない
102
+
103
+ .AllowMultiSelect = False
104
+
105
+ End If
106
+
107
+ '初期パスを設定
108
+
109
+ If Nz(pPath) <> "" Then
110
+
111
+ .InitialFileName = pPath
112
+
113
+ Else
114
+
115
+ .InitialFileName = CurrentProject.path
116
+
117
+ End If
118
+
119
+ 'ダイアログを表示
120
+
121
+ If .Show <> 0 Then
122
+
123
+ 'ファイルが選択されたとき
124
+
125
+ 'そのフルパスを返り値に設定
126
+
127
+ wGetFileName = Trim(.SelectedItems.Item(1))
128
+
129
+ End If
130
+
131
+ End With
132
+
133
+ MyFileDialog = wGetFileName
134
+
135
+ End Function
136
+
137
+ Sub PDF化コード()
138
+
139
+ Dim FldName As String
140
+
141
+ FldName = MyFileDialog(4, "PDF保存先を選択")
142
+
143
+ If FldName <> "" Then
144
+
145
+ DoCmd.OutputTo acOutputReport, "R_レポート名", acFormatPDF, FldName & "\保存するPDF.pdf"
146
+
147
+ End If
148
+
149
+ ```

2

推敲

2020/12/18 09:18

投稿

sazi
sazi

スコア25243

test CHANGED
@@ -23,8 +23,6 @@
23
23
  ```VBA
24
24
 
25
25
  Function SaveAsFileDialog()
26
-
27
- Dim strFiles As String
28
26
 
29
27
  With Application.FileDialog(msoFileDialogSaveAs)
30
28
 

1

追記

2020/12/18 08:45

投稿

sazi
sazi

スコア25243

test CHANGED
@@ -9,3 +9,67 @@
9
9
  ```
10
10
 
11
11
  [VBA:AccessのFileDialogを使用して[名前を付けて保存]ダイアログボックスを表示するサンプルプログラム](https://selifelog.com/blog-entry-249.html)
12
+
13
+ 追記
14
+
15
+ ---
16
+
17
+ こんな感じ。
18
+
19
+ ※msoFileDialogSaveAsの場合は、フィルター出来ないのが難点ですけどね。
20
+
21
+
22
+
23
+ ```VBA
24
+
25
+ Function SaveAsFileDialog()
26
+
27
+ Dim strFiles As String
28
+
29
+ With Application.FileDialog(msoFileDialogSaveAs)
30
+
31
+ 'FileDialogオブジェクトの各種プロパティを設定
32
+
33
+ .Title = "別名保存"
34
+
35
+ .ButtonName = "保存実行" 'デフォルトは[保存(&S)]
36
+
37
+ .InitialFileName = CurrentProject.Path
38
+
39
+ '複数ファイル選択を許可しない
40
+
41
+ .AllowMultiSelect = False
42
+
43
+
44
+
45
+ '[名前を付けて保存]ダイアログボックスを表示する
46
+
47
+ If .Show Then
48
+
49
+ SaveAsFileDialog = .SelectedItems(1)
50
+
51
+ Else
52
+
53
+ SaveAsFileDialog = ""
54
+
55
+ End If
56
+
57
+ End With
58
+
59
+ End Function
60
+
61
+ Sub PDF化コード()
62
+
63
+ Dim FileName As String
64
+
65
+ FileName = SaveAsFileDialog
66
+
67
+ If FileName <> "" Then
68
+
69
+ DoCmd.OutputTo acOutputReport, "R_レポート名", acFormatPDF, FileName
70
+
71
+ End If
72
+
73
+ End Sub
74
+
75
+ ```