竞赛[高8]最好和最简洁的文件打开对话框功能

andymark

调用一个打开对话框容易，写一个特色对话框就非得用API
见过别人的对话框可加上SKIN的, 很漂亮 还找不到思路

access3009

如果要完全量身定做的,还得自己写.
不过,怎么都是用微软的

tmtony

不错不错,更具体了!!

andymark

我也做了一个，并不算很完善，凑合先发上来
按要求是做一个调用最方便的对话框，首先想到的是把常用的类型先定义起来，同时也能支持自定义模式

1. Public Enum DialogType '定义对话框类型
   
2. Fileopen = 1
   
3. FileSaveAs = 2
   
4. FilePicker = 3
   
5. FolderPicker = 4
   
6. End Enum
   
7. 
   
8. Public Enum FilterType '定义筛选类型
   
9. All = 0 '所有文件
   
10. MsAccess = 1
    
11. MsWord = 2
    
12. MsExcel = 3
    
13. Txt = 4
    
14. HTML = 5
    
15. Photo = 6
    
16. Cust = 7 '自定义类型
    
17. End Enum
    
18. 
    
19. Public Const MsAllType As String = "*.*"
    
20. Public Const MsALLTitle As String = "所有文件"
    
21. Public Const MsAccessType As String = "*.mdb;*.adp;*.mda;*.mde;*.ade"
    
22. Public Const MsAccessTitle As String = "Microsoft Office Access"
    
23. Public Const HtmType As String = "*.html;*.htm;*.hta;*.asp"
    
24. Public Const HtmTitle As String = "网页"
    
25. Public Const TxtType As String = "*.txt"
    
26. Public Const TxtTitle As String = "文本文档"
    
27. Public Const MsExcelType As String = "*.xl;*.xls;*.xla;*.xlm;*.xlc;*.xlw"
    
28. Public Const MsExcelTitle As String = "Microsoft Office Excel"
    
29. Public Const MsWordType As String = "*.doc;*.dot"
    
30. Public Const MsWordTitle As String = "Microsoft Office Word"
    
31. Public Const PhotoType As String = "*.JPG;*.JPEG;*.JPE;*.JFIF;*.GIF;*.bmp,*.PNG,*.ico"
    
32. Public Const PhotoTitle As String = "图片文件"
    
33. 
    
34. 
    
35. Public Function GetFileName(DType As DialogType, txtFilter As FilterType, Optional txtFilterName As String, Optional ByVal strPath, Optional StrTitle As String) As String
    
36. 
    
37. '须引用 Micosoft Office 11.0 Object Library
    
38. 
    
39. '用途: 自定义对话框
    
40. '参数: DType 定义对话框类型 必选: Fileopen 打开 对话框;FileSaveAs 另存为 对话框;FilePicker 文件选取器 对话框;FolderPicker 文件夹选取器 对话框
    
41. ' txtFilter 定义几种常用类型 支持自定义类型 必选;
    
42. ' txtFilterName 可选,当txtFilter类型为Cust自定义,则txtFilterName表示自定义的筛选条件和名称,筛选条件和筛选名称用","分隔:亦表示保存的文件名
    
43. ' strPath 文件路径　可选
    
44. ' StrTitle 自定义对话框名称,可选;缺省为系统自带的
    
45. '用法: GetFileName Fileopen, MsAccess
    
46. ' GetFileName FileSaveAs, MsExcel, "Tes.xls"
    
47. ' GetFileName Fileopen, Cust, "*.doc;*.xls;*.mdb"
    
48. ' GetFileName Fileopen, Cust, "*.doc;*.xls;*.mdb,My Dialog"
    
49. ' GetFileName Fileopen, Cust, "*.doc;*.xls;*.mdb,My Dialog", , "自定义标题"
    
50. ' GetFileName Fileopen, MsAccess, , , "自定义标题"
    
51. ' GetFileName Fileopen, Photo, , "D:"
    
52. 
    
53. 
    
54. 
    
55. Dim StrFilter As String
    
56. Dim StrFilterTitle As String
    
57. Dim fDialog As Office.FileDialog
    
58. 
    
59. 
    
60. Select Case txtFilter
    
61. 
    
62. Case All
    
63. 
    
64. StrFilter = MsAllType
    
65. StrFilterTitle = MsALLTitle
    
66. 
    
67. Case MsAccess
    
68. 
    
69. StrFilter = MsAccessType
    
70. StrFilterTitle = MsAccessTitle
    
71. 
    
72. Case MsWord
    
73. 
    
74. StrFilter = MsWordType
    
75. StrFilterTitle = MsWordTitle
    
76. 
    
77. Case MsExcel
    
78. 
    
79. StrFilter = MsExcelType
    
80. StrFilterTitle = MsExcelTitle
    
81. 
    
82. Case Txt
    
83. 
    
84. StrFilter = TxtType
    
85. StrFilterTitle = TxtTitle
    
86. 
    
87. Case HTML
    
88. 
    
89. StrFilter = HtmType
    
90. StrFilterTitle = HtmTitle
    
91. 
    
92. Case Photo
    
93. 
    
94. StrFilter = PhotoType
    
95. StrFilterTitle = PhotoTitle
    
96. 
    
97. Case Cust
    
98. 
    
99. Dim Mypos
    
100. 
     
101. If IsMissing(txtFilterName) Then
     
102. 
     
103. MsgBox "你选择了自定义类型，请在txtFilterName选项中填写筛选数据"
     
104. 
     
105. Exit Function
     
106. Else
     
107. 
     
108. Mypos = InStr(1, txtFilterName, ",")
     
109. 
     
110. 
     
111. If Mypos > 0 Then
     
112. 
     
113. StrFilter = Mid(txtFilterName, 1, Mypos - 1)
     
114. StrFilterTitle = Mid(txtFilterName, Mypos + 1, Len(txtFilterName) - Mypos)
     
115. Else
     
116. StrFilter = txtFilterName
     
117. StrFilterTitle = "自定义类型"
     
118. 
     
119. End If
     
120. 
     
121. End If
     
122. 
     
123. End Select
     
124. 
     
125. Set fDialog = Application.FileDialog(DType)
     
126. 
     
127. With fDialog
     
128. 
     
129. .AllowMultiSelect = False
     
130. 
     
131. If IsMissing(strPath) Then
     
132. .InitialFileName = CurrentProject.Path
     
133. Else
     
134. .InitialFileName = strPath
     
135. End If
     
136. 
     
137. If Not IsMissing(StrTitle) Then
     
138. .Title = StrTitle
     
139. End If
     
140. 
     
141. 
     
142. If DType <> FileSaveAs Then
     
143. 
     
144. .Filters.Clear
     
145. .Filters.Add StrFilterTitle, StrFilter
     
146. 
     
147. Else
     
148. 
     
149. .InitialFileName = txtFilterName
     
150. End If
     
151. 
     
152. .Show
     
153. End With
     
154. 
     
155. If fDialog.SelectedItems.Count > 0 Then
     
156. 
     
157. GetFileName = fDialog.SelectedItems(1)
     
158. 
     
159. Else
     
160. 
     
161. GetFileName = ""
     
162. 
     
163. End If
     
164. 
     
165. Set fDialog = Nothing
     
166. 
     
167. 
     
168. End Function

复制代码

xinbao

这么多代码,学习学习

andymark

呵呵, 这个还没考虑多选的问题呢

tmtony

原帖由 andymark 于 2008-3-6 16:33 发表
呵呵, 这个还没考虑多选的问题呢

一考虑多选,代码又多了

fan0217

不用先期绑定的方式，可以不引用Micosoft Office 1X.0 Object Library

fan0217

andymark：
其实可以不用定义：Public Enum DialogType '定义对话框类型，因为引用了Micosoft Office 1X.0 Object Library后是可以使用枚举：MsoFileDialogType

andymark

这个我知道，微软那个东东有点长