競(jìng)賽[高8]最好和最簡(jiǎn)潔的文件打開(kāi)對(duì)話(huà)框功能

andymark

調(diào)用一個(gè)打開(kāi)對(duì)話(huà)框容易，寫(xiě)一個(gè)特色對(duì)話(huà)框就非得用API
見(jiàn)過(guò)別人的對(duì)話(huà)框可加上SKIN的, 很漂亮 還找不到思路

access3009

如果要完全量身定做的,還得自己寫(xiě).
不過(guò),怎么都是用微軟的

tmtony

不錯(cuò)不錯(cuò),更具體了!!

andymark

我也做了一個(gè)，并不算很完善，湊合先發(fā)上來(lái)
按要求是做一個(gè)調(diào)用最方便的對(duì)話(huà)框，首先想到的是把常用的類(lèi)型先定義起來(lái)，同時(shí)也能支持自定義模式

1. Public Enum DialogType '定義對(duì)話(huà)框類(lèi)型
   
2. Fileopen = 1
   
3. FileSaveAs = 2
   
4. FilePicker = 3
   
5. FolderPicker = 4
   
6. End Enum
   
7. 
   
8. Public Enum FilterType '定義篩選類(lèi)型
   
9. All = 0 '所有文件
   
10. MsAccess = 1
    
11. MsWord = 2
    
12. MsExcel = 3
    
13. Txt = 4
    
14. HTML = 5
    
15. Photo = 6
    
16. Cust = 7 '自定義類(lèi)型
    
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 = "網(wǎng)頁(yè)"
    
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. '用途: 自定義對(duì)話(huà)框
    
40. '參數(shù): DType 定義對(duì)話(huà)框類(lèi)型 必選: Fileopen 打開(kāi) 對(duì)話(huà)框;FileSaveAs 另存為 對(duì)話(huà)框;FilePicker 文件選取器 對(duì)話(huà)框;FolderPicker 文件夾選取器 對(duì)話(huà)框
    
41. ' txtFilter 定義幾種常用類(lèi)型 支持自定義類(lèi)型 必選;
    
42. ' txtFilterName 可選,當(dāng)txtFilter類(lèi)型為Cust自定義,則txtFilterName表示自定義的篩選條件和名稱(chēng),篩選條件和篩選名稱(chēng)用","分隔:亦表示保存的文件名
    
43. ' strPath 文件路徑　可選
    
44. ' StrTitle 自定義對(duì)話(huà)框名稱(chēng),可選;缺省為系統(tǒng)自帶的
    
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", , "自定義標(biāo)題"
    
50. ' GetFileName Fileopen, MsAccess, , , "自定義標(biāo)題"
    
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 "你選擇了自定義類(lèi)型，請(qǐng)?jiān)趖xtFilterName選項(xiàng)中填寫(xiě)篩選數(shù)據(jù)"
     
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 = "自定義類(lèi)型"
     
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

復(fù)制代碼

xinbao

這么多代碼,學(xué)習(xí)學(xué)習(xí)

andymark

呵呵, 這個(gè)還沒(méi)考慮多選的問(wèn)題呢

tmtony

原帖由 andymark 于 2008-3-6 16:33 發(fā)表
呵呵, 這個(gè)還沒(méi)考慮多選的問(wèn)題呢

一考慮多選,代碼又多了

fan0217

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

fan0217

andymark：
其實(shí)可以不用定義：Public Enum DialogType '定義對(duì)話(huà)框類(lèi)型，因?yàn)橐�用了Micosoft Office 1X.0 Object Library后是可以使用枚舉：MsoFileDialogType

andymark

這個(gè)我知道，微軟那個(gè)東東有點(diǎn)長(zhǎng)