|
|
楼主 |
发表于 2017-7-30 01:11:18
|
显示全部楼层
来自： 中国陕西西安
- Option Explicit
! ?7 m: c m2 }1 H( g) h5 O
% v' Q" j; j, w- A3 {3 A8 |2 _6 n- ' 定义用户类型，以减少＃if VBA7语句的数量，但不能消除他们...
, ]' q/ Z1 L# O5 o( u% T - Private Type LongPtr_T* N& F" W& ?' W, }$ U- J
- #If VBA7 Then
1 U; L; `% x4 N% I - Value As LongPtr
7 [! u6 h* g2 s# S% b+ g* z - ' Compare automatically resized LongPtr to fixed size Long and LongLong
" }# F6 m5 T) o' y( \$ u" } - #Else5 r$ e( y$ i/ b; F' _. g5 _, C
- Value As Long
' j9 s' u% r% b/ q4 b# L9 O5 {* m - #End If
* c+ i9 o$ t ]9 K5 _5 L4 | - End Type. m" L6 a, D" z* R+ g" C6 h$ Q; z
6 |* b1 }6 {* `! ~; b% u' C- ' Win32 数据类型. Different signatures for different versions of VBA8 `- r' i7 t3 ~# U+ ]4 o/ d2 _/ q. |
- Private Type BROWSEINFO
+ n7 f5 q8 ?/ s - #If VBA7 Then
4 Q+ ]# g/ R" ~4 a# b R$ G - hWndOwner As LongPtr3 @* e9 c0 K: H+ u Q/ i2 @' S5 i
- pIDLRoot As LongPtr/ G" _3 m$ e9 p
- pszDisplayName As Long. n+ q; `$ I/ n0 \; W; v0 U
- lpszTitle As String
9 }9 U) Z& H2 |1 R - ulFlags As Long
/ m( N1 A* ?& h% ]: e - lpfnCallback As LongPtr
* Q4 Y8 Z8 m( [; Z - lParam As Long7 [# N j: U: ?3 Z# }
- iImage As Long1 G1 ^4 b/ B1 R* L; ^/ z
- #Else- K7 o* U* i `+ E
- hWndOwner As Long w8 Y& b L3 J1 H) n+ k
- pIDLRoot As Long) |* h+ G) [, ]8 y% X: M
- pszDisplayName As Long; `8 e1 }' h% n9 y. ? b7 w# F9 D
- lpszTitle As String
3 Y9 f; ~7 z9 W) H - ulFlags As Long
* i+ d6 f5 Z3 B5 j e - lpfnCallback As Long
) G' x* j; r6 k - lParam As Long1 m0 D) A: @/ F9 X# ]
- iImage As Long
% z6 O+ C2 I' f5 s7 \, v2 e - #End If
7 K9 i5 `3 \4 ]! J3 U7 ?9 y1 r: U - End Type
" s$ ?- q2 u6 p0 ~9 d7 n% F+ f
2 B9 b' t" p \1 ]' c7 O- Private Const MAX_PATH = 260
( w* i* p8 ~# } L) p& Q9 g- K - 'Directories only$ \ N4 y* p; j: ~
- Private Const BIF_RETURNONLYFSDIRS = &H1&" N @) E4 H5 w1 }3 m
- 'Windows 2000 (Shell32.dll 5.0) extended dialog- @& ~2 z# V7 T- I' d. f$ R0 m X
- Private Const BIF_NEWDIALOGSTYLE = &H40
% Z( P& V7 a M% f( j9 g' V( @5 ~ - ' show edit box
1 H1 r* q) d. u$ f. _ - Private Const BIF_EDITBOX = &H10&+ C/ H" |4 N8 @
- 2 w N# H+ D% N
- Private Const WM_USER = &H400
( @# A e4 x* i - Private Const BFFM_INITIALIZED = 1
# t# N& X' j1 L3 ~ - Private Const BFFM_SELCHANGED = 21 T* K+ k' o1 U5 l4 S; b2 m
- Private Const BFFM_SETSTATUSTEXTA = (WM_USER + 100)
8 }! Z- q9 c! q3 j, T - , R9 v; A, C& E% n/ q
- Private Const BFFM_SETSELECTIONA = (WM_USER + 102)
( H3 l) e) O9 E: A - Private Const BFFM_SETEXPANDED = (WM_USER + 16)
* H {1 T8 m; ~7 d/ ?, `0 Q
3 D: k4 a: e! U( E |) \! E- Private m_sDefaultFolder As String
6 g, _7 q2 P# q7 @' f
+ T$ P) E( ]; i- U) \ g# y/ S& d- Public Const SWP_NOMOVE = 2
3 I9 A: @. `) G5 k3 d- C - Public Const SWP_NOSIZE = 1
9 t2 N6 T2 S- L! V4 { - Private Const SWP_NOZORDER = 4
& C+ P1 R3 K* B1 z
4 T: p# Q+ ^; ~% N8 O' n- Private Type RECT @+ C6 c3 A1 j4 ~* ]( y3 U
- Left As Long
/ D4 l6 ]5 y6 N: r; o" g - Top As Long
# b1 e" B+ [9 e4 T o - Right As Long3 l7 b/ d o4 {/ P. N2 W
- Bottom As Long% F4 ^7 i$ m% t1 @& C8 m3 C" D
- End Type4 M" @7 |# N4 E) `
- 1 u' f1 r# _7 r: U9 `
- ' Win32 API declarations. Different signatures for different versions of VBA.
$ N/ i6 J% r/ N9 T8 G- } - ' Note the mandatory use of PtrSafe keyword in VBA7.
- @3 c# W+ U2 s7 q" t9 \ - #If VBA7 Then, {3 p' S0 v# @
- Private Declare PtrSafe Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
' \- T# H$ G# @- R1 x: z P: z# ?2 c - Private Declare PtrSafe Function SHBrowseForFolder Lib "Shell32" (lpbi As BROWSEINFO) As Long5 g9 g% G3 Y$ ?5 K3 q* C
- Private Declare PtrSafe Function SHGetPathFromIDList Lib "Shell32" (ByVal pidList As LongPtr, ByVal lpBuffer As String) As Long/ _3 q) n+ x1 [4 ?
- Private Declare PtrSafe Sub CoTaskMemFree Lib "ole32" (ByVal hMem As LongPtr)
, M0 `/ a$ d1 x0 R$ m& m6 Q/ y6 b - Private Declare PtrSafe Function SetWindowPos Lib "USER32" (ByVal hWnd As LongPtr, _
) Y! c5 `/ o: X) Q) t! O | - ByVal hWndInsertAfter As LongPtr, _
$ J- T% y: O/ I - ByVal x As Long, _0 J4 P9 A7 U6 w X. a! D0 B
- ByVal y As Long, _
/ X) K7 r: H, F* u - ByVal cx As Long, _
`; N% `: Q1 b6 C& \ - ByVal cy As Long, _) w8 M0 M( _3 x5 u& f
- ByVal wFlags As Long) As Long- v* ?* W2 c. P) K. x- Z t3 i+ H& v
- Private Declare PtrSafe Function GetWindowRect Lib "user32.dll" (ByVal hWnd As LongPtr, lpRect As RECT) As Long* l8 _7 D, ?0 x
. F2 }7 k3 T8 t0 h+ n) k2 ?- #Else
* h: q9 a( R, v+ R# X" w - Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
8 @' Z, a; B* u7 S - Private Declare Function SHBrowseForFolder Lib "Shell32" (lpbi As BROWSEINFO) As Long4 R& l# t& N: P, i# p1 h
- Private Declare Function SHGetPathFromIDList Lib "Shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
! v% D( L6 L) m; P9 b - Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal hMem As Long)
9 t4 Q, P) T& { X8 H8 k2 y, _ - Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, _1 g: k( @- a) Z4 e+ ~
- ByVal hWndInsertAfter As Long, _
7 X* D! t- L) U# F5 @% p4 e - ByVal x As Long, _
: i6 G, g1 y$ x8 G3 A. P - ByVal y As Long, _
$ L2 m/ H/ N$ s& T) h - ByVal cx As Long, _
8 v) {3 E: X& u3 i - ByVal cy As Long, _
6 O& P* O% B* K8 M; @5 K/ } - ByVal wFlags As Long) As Long3 m$ W" w, ~. d, D6 w2 Z1 R) f+ X
- Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hWnd As Long, lpRect As RECT) As Long, i9 \1 s0 Y9 _# I# w
- 4 d/ N3 i5 m; i* e( x
- #End If1 I/ ? Z; G) w4 X/ { n1 P
- 9 A1 h+ f) T8 T- @6 S
- Private lastKnownPosition As RECT
; j( o+ C$ o( [- ` - Private lockLastKnownPosition As Boolean
梁大，将这一段修改一下 |
|
发表于 2017-7-29 14:05:12
发表于 2017-7-29 15:10:55
