Kiểm tra tên các workbook đang mở để xác định 1 file đã mở hay chưa. (1 người xem)

friendship293a · 13/3/10

Ai có code lấy tên các workbook đang mở không cho mình tham khảo với. Thanks!

Hai Lúa Miền Tây · 13/3/10

friendship293a đã viết:
Ai có code lấy tên các workbook đang mở không cho mình tham khảo với. Thanks!

Bạn dùng code này nhé:

Mã:

Sub XemWb()
    Dim wb As Workbook
     
    For Each wb In Application.Workbooks
        MsgBox wb.FullName
    Next
     
End Sub

friendship293a · 13/3/10

Nó chỉ hiện được tên workbook có code còn mình muốn in ra tất cả các tên workbook mình đang bật cơ( kể cả workbook không có code) thanks!

ndu96081631 · 13/3/10

friendship293a đã viết:
Nó chỉ hiện được tên workbook có code còn mình muốn in ra tất cả các tên workbook mình đang bật cơ( kể cả workbook không có code) thanks!

Bạn thử code chưa mà nói vậy chứ?
Yêu cầu này cũng có thể dùng công thức được đấy nhé!
Ẹc... Ẹc...

friendship293a · 13/3/10

Mình thử nhiều lần rồi. bạn Test lại dùm mình nhé!

ndu96081631 · 13/3/10

friendship293a đã viết:
Mình thử nhiều lần rồi. bạn Test lại dùm mình nhé!

Đương nhiên là tôi đã test và xác định code ấy chính xác
Còn bạn test thế nào? Cho file chứa code đang test ấy lên xem thử!

friendship293a · 13/3/10

Mình test thế này. mình bật 1 workbook đầu tiên lên nó tên là book1 sau đó bật tiếp workbook 2 nó tên là book2 sau đó mình nhấn Alt+F11 -> Insert module nhập đoạn code trên vào và run nó chỉ thông báo là book2 mà không thông báo book1.
Ko biết Test thế đúng chưa bạn?

ndu96081631 · 13/3/10

friendship293a đã viết:
Mình test thế này. mình bật 1 workbook đầu tiên lên nó tên là book1 sau đó bật tiếp workbook 2 nó tên là book2 sau đó mình nhấn Alt+F11 -> Insert module nhập đoạn code trên vào và run nó chỉ thông báo là book2 mà không thông báo book1.
Ko biết Test thế đúng chưa bạn?

Bạn làm như thế này nè:
- Double click vào các file (file nào bạn muốn mở)
- Đứng ở 1 file nào đó, bấm Ctrl + N, xong hãy chèn code và chạy thử
Bạn làm không ra kết quả là vì bạn khởi động 2 lần Excel khác nhau (2 session khác nhau) nên Workbook này không "nhìn thấy" Workbbok kia
Kiểm tra đơn giản nhất là: Ở tại 1 Workbook nào đó, vào menu Window xem có thấy tên các Workbook khác được liệt kê tại đây không?
Nhớ nha: Double Click vài file, xong Ctrl + N và chèn code
Tình huống như bạn vừa nói tôi vẫn chưa nghĩ ra cách khắc phục

Hai Lúa Miền Tây · 13/3/10

Đề bài là tất cả file mà bạn

friendship293a · 13/3/10

Đấy cái mình gặp khó khăn là các workbook mở bằng cách kích chuột chứ không phải là tạo new nhấn Ctrl + N như bạn nói. mình định duyệt tất cả các workbook hiện hành xem workbook có tên là book2 đã được mở hay chưa? các bạn thử nghĩ coi có cách nào không?

Hai Lúa Miền Tây · 13/3/10

friendship293a đã viết:
Đấy cái mình gặp khó khăn là các workbook mở bằng cách kích chuột chứ không phải là tạo new nhấn Ctrl + N như bạn nói. mình định duyệt tất cả các workbook hiện hành xem workbook có tên là book2 đã được mở hay chưa? các bạn thử nghĩ coi có cách nào không?

Bạn có thể cho mình biết ý định của bạn là gì không ? Có thể có cách khác hay hơn.

Code của bạn đây:

Mã:

Private Sub Workbook_Open()
Dim wbk As Workbook
For Each wbk In Workbooks
If wbk.Name = "Book2.xls" Then
MsgBox "File cua ban da duoc mo roi "
Application.ThisWorkbook.Close
End If
Next

End Sub

ndu96081631 · 13/3/10

domfootwear đã viết:
Bạn có thể cho mình biết ý định của bạn là gì không ? Có thể có cách khác hay hơn.

Nghĩ cũng lạ... Vụ này tưởng đơn giản, vậy mà tìm trên google muốn "banh ta long" luôn cũng chẳng thấy câu trả lời nào thỏa đáng
Không biết các cao thủ nghĩ sao về đề tài này nhi? Cũng khá thú vị đấy chứ!

ndu96081631 · 14/3/10

Ái chà...
Hôm qua đến giờ nghiên cứu vụ này mới phát hiện thì ra mấy cái Function như phát hiện 1 Workbook đang mở:

PHP:

Function WbIsOpen(wbName As String) As Boolean
  On Error Resume Next
  WbIsOpen = Not Workbooks(wbName & ".xls") Is Nothing
End Function

hình như không dùng được (trong trường hợp mở Excel giống như tác giả topic này)
Một ngày nào đó ta mở 2 file Excel (mở bằng 2 session) rồi dùng code trên kiểm tra workbook có đang mở hay không... nó lại cho kết quả = False thì ... thật buồn cười
Chẳng lẽ không có code nào làm việc được với MutiSession hay sao ta? ---> Phải xem lại kiến thức mà ta đã học thôi vì rắc rối này đã kéo theo thêm mấy rắc rối khác ---> Hic...
Trên mạng cũng đã có người quan tâm đến vấn đề này... xem tại đây:
http://www.mrexcel.com/forum/showthread.php?t=72743
Tuy nhiên các câu trả lời cũng chưa giải quyết triệt để được vấn đề

thanhlanh · 21/12/12

ndu96081631 đã viết:
Ái chà...
Hôm qua đến giờ nghiên cứu vụ này mới phát hiện thì ra mấy cái Function như phát hiện 1 Workbook đang mở:

PHP:

Function WbIsOpen(wbName As String) As Boolean On Error Resume Next WbIsOpen = Not Workbooks(wbName & ".xls") Is Nothing End Function

hình như không dùng được (trong trường hợp mở Excel giống như tác giả topic này)
Một ngày nào đó ta mở 2 file Excel (mở bằng 2 session) rồi dùng code trên kiểm tra workbook có đang mở hay không... nó lại cho kết quả = False thì ... thật buồn cười
Chẳng lẽ không có code nào làm việc được với MutiSession hay sao ta? ---> Phải xem lại kiến thức mà ta đã học thôi vì rắc rối này đã kéo theo thêm mấy rắc rối khác ---> Hic...
Trên mạng cũng đã có người quan tâm đến vấn đề này... xem tại đây:
http://www.mrexcel.com/forum/showthread.php?t=72743
Tuy nhiên các câu trả lời cũng chưa giải quyết triệt để được vấn đề

Vấn đề này được giải quyết chưa bạn?

ndu96081631 · 21/12/12

thanhlanh đã viết:
Vấn đề này được giải quyết chưa bạn?

Mới cách đây mấy ngày mà anh:
http://www.giaiphapexcel.com/forum/...một-file-đang-mở-hay-đóng&p=460762#post460762

thanhlanh · 21/12/12

Không, ý mình là liệt kê tất cả các Workbooks đang mở trên tất cả các session chớ không phải kiểm tra một file nào đó đã được mở hay chưa.

Hai Lúa Miền Tây · 21/12/12

thanhlanh đã viết:
Không, ý mình là liệt kê tất cả các Workbooks đang mở trên tất cả các session chớ không phải kiểm tra một file nào đó đã được mở hay chưa.

Hihi, mới google được: http://www.xtremevbtalk.com/showthread.php?t=298539
Chép code sau vào module
[GPECODE=vb]Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetRunningObjectTable Lib "ole32.dll" (ByVal dwReserved As Long, pROT As Long) As Long
Private Declare Function CreateBindCtx Lib "ole32.dll" (ByVal dwReserved As Long, pBindCtx As Long) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Declare Sub OleInitialize Lib "ole32.dll" (pvReserved As Any)
Private Declare Sub OleUninitialize Lib "ole32.dll" ()
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, _
ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)
Private Declare Function PutMem2 Lib "msvbvm60" (ByVal pWORDDst As Long, ByVal NewValue As Long) As Long
Private Declare Function PutMem4 Lib "msvbvm60" (ByVal pDWORDDst As Long, ByVal NewValue As Long) As Long
Private Declare Function GetMem4 Lib "msvbvm60" (ByVal pDWORDSrc As Long, ByVal pDWORDDst As Long) As Long
Private Declare Function VarPtr Lib "msvbvm60" (var As Any) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function CopyStringA Lib "kernel32" Alias "lstrcpyA" (ByVal NewString As String, ByVal OldString As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Function lstrlenA Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal codepage As Long, ByVal dwFlags As Long, _
lpWideCharStr As Any, ByVal cchWideChar As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, _
ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long

Private Const GMEM_FIXED As Long = &H0
Private Const asmPUSH_imm32 As Byte = &H68
Private Const asmRET_imm16 As Byte = &HC2
Private Const asmRET_16 As Long = &H10C2&
Private Const asmCALL_rel32 As Byte = &HE8

'IUnknown vTable ordinals
Private Const unk_QueryInterface As Long = 0
Private Const unk_AddRef As Long = 1
Private Const unk_Release As Long = 2
Private Const vtbl_ROT_EnumRunning = 9
Private Const vtbl_EnumMoniker_Next = 3
Private Const vtbl_Moniker_GetDisplayName = 20

'Function to call Interface members by ordinal in VTable
Private Function CallInterface(ByVal pInterface As Long, ByVal FuncOrdinal As Long, _
ByVal ParamsCount As Long, Optional ByVal p1 As Long = 0, Optional ByVal p2 As Long = 0, _
Optional ByVal p3 As Long = 0, Optional ByVal p4 As Long = 0, Optional ByVal p5 As Long = 0, _
Optional ByVal p6 As Long = 0, Optional ByVal p7 As Long = 0, Optional ByVal p8 As Long = 0, _
Optional ByVal p9 As Long = 0, Optional ByVal p10 As Long = 0) As Long
Dim i As Long, t As Long
Dim hGlobal As Long, hGlobalOffset As Long

If ParamsCount < 0 Then Err.Raise 5 'invalid call
If pInterface = 0 Then Err.Raise 5

'5 bytes for each parameter
'5 bytes - PUSH this
'5 bytes - call member function
'3 bytes - ret 0x0010, pop CallWindowProc
'1 byte - dword align.

hGlobal = GlobalAlloc(GMEM_FIXED, 5 * ParamsCount + 5 + 5 + 3 + 1)
If hGlobal = 0 Then Err.Raise 7 'insuff. memory
hGlobalOffset = hGlobal

If ParamsCount > 0 Then
t = VarPtr(p1)
For i = ParamsCount - 1 To 0 Step -1
PutMem2 hGlobalOffset, asmPUSH_imm32
hGlobalOffset = hGlobalOffset + 1
GetMem4 t + i * 4, hGlobalOffset
hGlobalOffset = hGlobalOffset + 4
Next
End If

'First member of any interface - this. Assign...
PutMem2 hGlobalOffset, asmPUSH_imm32
hGlobalOffset = hGlobalOffset + 1
PutMem4 hGlobalOffset, pInterface
hGlobalOffset = hGlobalOffset + 4

'Call IFace Function by its ordinal
PutMem2 hGlobalOffset, asmCALL_rel32
hGlobalOffset = hGlobalOffset + 1

GetMem4 pInterface, VarPtr(t) 'dereference: find vTable
GetMem4 t + FuncOrdinal * 4, VarPtr(t) 'Function offset in vTable, dereference
PutMem4 hGlobalOffset, t - hGlobalOffset - 4
hGlobalOffset = hGlobalOffset + 4

'all interfaces are stdcall, so forget about stack clearing
PutMem4 hGlobalOffset, asmRET_16 'ret 0x0010

CallInterface = CallWindowProc(hGlobal, 0, 0, 0, 0)

GlobalFree hGlobal

End Function

Private Function StrFromPtrA(ByVal lpszA As Long, Optional nSize As Long = 0) As String
Dim s As String, bTrim As Boolean
If nSize = 0 Then
nSize = lstrlenA(lpszA)
bTrim = True
End If
s = String(nSize, Chr$(0))
CopyStringA s, ByVal lpszA
If bTrim Then s = TrimNULL(s)
StrFromPtrA = s
End Function

Private Function StrFromPtrW(ByVal lpszW As Long, Optional nSize As Long = 0) As String
Dim s As String, bTrim As Boolean
If nSize = 0 Then
nSize = lstrlenW(lpszW) * 2
bTrim = True
End If
s = String(nSize, Chr$(0))
' CopyMemory ByVal StrPtr(s), ByVal lpszW, nSize ' VBA doesn't support StrPtr
WideCharToMultiByte 0, &H0, ByVal lpszW, -1, ByVal s, Len(s), &H0, &H0
If bTrim Then s = TrimNULL(s)
StrFromPtrW = s
End Function

Private Function TrimNULL(ByVal str As String) As String
If InStr(str, Chr$(0)) > 0& Then
TrimNULL = Left$(str, InStr(str, Chr$(0)) - 1&)
Else
TrimNULL = str
End If
End Function

Public Function GetAllInstances() As Collection
Dim pROT As Long, pEnumMoniker As Long, pMoniker As Long, pBindCtx As Long
Dim ret As Long, nCount As Long, CheckForInstance As Boolean, Key As String
Dim pName As Long, RegisteredName As String, ExcelApp As Application

ret = GetRunningObjectTable(0, pROT)
ret = CreateBindCtx(0, pBindCtx)
CallInterface pROT, vtbl_ROT_EnumRunning, 1, VarPtr(pEnumMoniker)
While CallInterface(pEnumMoniker, vtbl_EnumMoniker_Next, 3, 1, VarPtr(pMoniker), VarPtr(nCount)) = 0
CallInterface pMoniker, vtbl_Moniker_GetDisplayName, 3, pBindCtx, 0, VarPtr(pName)
'For win9x you'll need StrFromPtrA

RegisteredName = StrFromPtrW(pName)
If InStr(LCase(RegisteredName), "book") Then
CheckForInstance = True
Else
Select Case Right(RegisteredName, 3)
Case "xla", "slk", "dif", "csv", "txt", "prn", "dbf", "wq1", "wks", "wk1", "wk3", "wk4", "xlw", "xls", "xlt", "htm", "mht", "xml"
CheckForInstance = True
End Select
Select Case Right(RegisteredName, 5)
Case ".html", "mhtml"
CheckForInstance = True
End Select
End If

If CheckForInstance Then
CheckForInstance = False
If ParentIsExcel(RegisteredName, ExcelApp) Then
If GetAllInstances Is Nothing Then Set GetAllInstances = New Collection
Key = CStr(ObjPtr(ExcelApp))
If Not InstanceAlreadyCollected(GetAllInstances, Key) Then
GetAllInstances.Add ExcelApp, Key
End If
End If
End If

CallInterface pMoniker, unk_Release, 0
CoTaskMemFree pName
Wend
CallInterface pEnumMoniker, unk_Release, 0
CallInterface pBindCtx, unk_Release, 0
CallInterface pROT, unk_Release, 0
Exit Function

End Function

Private Function ParentIsExcel(ByVal RegisteredName As String, ExcelApp As Application) As Boolean
On Error Resume Next

Set ExcelApp = GetObject(RegisteredName).Parent
If ExcelApp.Name = "Microsoft Excel" Then
ParentIsExcel = True
End If

End Function

Private Function InstanceAlreadyCollected(GetAllInstances As Collection, Key As String) As Boolean
On Error GoTo Err_InstanceAlreadyCollected
Dim o As Application
Set o = GetAllInstances(Key)
InstanceAlreadyCollected = True
Err_InstanceAlreadyCollected:
End Function

[/GPECODE]

Rồi tiếp tục chép code sau vào bên dưới module, xong chạy code này:

[GPECODE=vb]Sub Example()
Dim AllExcelApps As Collection, ExcelApp As Application, wb As Workbook, Pid As Long

Set AllExcelApps = GetAllInstances
If Not AllExcelApps Is Nothing Then
For Each ExcelApp In AllExcelApps
GetWindowThreadProcessId ExcelApp.hwnd, Pid
Debug.Print ExcelApp.Caption & ", Process ID = " & Pid
For Each wb In ExcelApp.Workbooks
Debug.Print " " & wb.Name
Next
Next
End If
End Sub

[/GPECODE]

Bạn có thể sửa code trên để đóng file.

Dài thấy ớn, cao thủ nào test và rút gọn bớt dùm

ndu96081631 · 21/12/12

Hai Lúa Miền Tây đã viết:
Dài thấy ớn, cao thủ nào test và rút gọn bớt dùm

Dài ngắn không quan trọng, chính xác là được
Hai Lúa thử kiểm tra với tên file là tiếng Việt Unicode xem có được không?

Hai Lúa Miền Tây · 21/12/12

Hic nếu file TV nó sẽ như sau Thầy à:

ndu96081631 · 21/12/12

Hai Lúa Miền Tây đã viết:
Hic nếu file TV nó sẽ như sau Thầy à:

Thì đương nhiên vậy rồi (môi trường VB đâu hổ trợ Unicode)
Hai lúa đưa các tên WB xuống sheet xem thế nào:

Mã:

Dim n as Long
For Each wb In ExcelApp.Workbooks
  n = n +1
  Cells(n, 1) = wb.Name
Next

Chỉ cần yêu cầu nó xác định chính xác tên là OK

thanhlanh · 21/12/12

Hai Lúa Miền Tây đã viết:

Hic nếu file TV nó sẽ như sau Thầy à:

Mã:

Sub Example() 
     Dim AllExcelApps As Collection, ExcelApp As Application, wb As Workbook, Pid As Long
      
     Set AllExcelApps = GetAllInstances 
     If Not AllExcelApps Is Nothing Then
        For Each ExcelApp In AllExcelApps 
            [COLOR=#ff0000]GetWindowThreadProcessId ExcelApp.hwnd, Pid [/COLOR]
            Debug.Print ExcelApp.Caption & ",  Process ID = " & Pid 
            For Each wb In ExcelApp.Workbooks 
                Debug.Print "    " & wb.Name 
            Next
        Next
     End If
End Sub

Mình test, nó không hiện thị được file có dấu tiếng Việt, ngoài ra nếu code nằm trong file có dấu tiếng Việt, nó bị lỗi tại dòng màu đỏ: GetWindowThreadProcessId ExcelApp.hwnd, Pid.

-------------------------------------------------------------

Vọc từ sáng giờ rốt cuộc cũng hoàn thiện được, không quá dài, gởi tặng mọi người.
Liệt kê được tất cả các File Excel đang mở trên tất cả các session, kể cả có dấu tiếng Việt.

P/s: Dạo này (từ khi diễn đàn có chức năng hiển thị STT các dòng code) trang nào có code thì rất khó mở, chỉ hiển thị được một ít ở phần đầu trang.Càng dài càng khó mở, phải mở nhiều lần mới được. Các bạn có ai bị vậy không?

thanhlanh · 22/12/12

Bạn nào dùng Excel2010 kiểm tra file trên (Liệt kê các file Excel đang mở.xls) giùm!

ndu96081631 · 22/12/12

thanhlanh đã viết:
Bạn nào dùng Excel2010 kiểm tra file trên (Liệt kê các file Excel đang mở.xls) giùm!

Đã thí nghiệm code trên Excel 2010, liệt kê được các file kể cả là tên tiếng Việt có dấu
Cần nói thêm rằng máy em có 2 Office: Bộ Office 2010 được cài đặt và Office 2003 dạng Portable. Em mở 2 file trên Excel 2003 và 2 file trên Excel 2010 (gồm file của anh). Chạy code, liệt kê được chính xác 4 file

ptm0412 · 22/12/12

1. Hỏi tác giả chèn code vào book1 hay book2?
2. "Bật" là gì? Là double vào tên file trong explorer, hay Open file? "Bật" lần thứ nhất là bật excel và có ngay book1, hay mở 1 file book1.xls có sẵn trên máy?
3. Nhiều khi tác giả chưa lưu file mới cho book1 không chừng ấy.

Mình test thế này. mình bật 1 workbook đầu tiên lên nó tên là book1 sau đó bật tiếp workbook 2 nó tên là book2 sau đó mình nhấn Alt+F11 -> Insert module nhập đoạn code trên vào và run nó chỉ thông báo là book2 mà không thông báo book1.
Ko biết Test thế đúng chưa bạn?

Chán kiểu viết không rõ ràng quá. Tên file cũng không đặt cho có hệ thống.

thanhlanh · 22/12/12

ptm0412 đã viết:
Nhiều khi tác giả chưa lưu file mới cho book1 không chừng ấy.

Chưa lưu hay không cũng được liệt kê hết mà anh!

Hai Lúa Miền Tây · 22/12/12

Nó sẽ liệt kê tất tần tật những file excel đang mở.

ptm0412 · 22/12/12

Hai Lúa Miền Tây đã viết:
Nó sẽ liệt kê tất tần tật những file excel đang mở.

Nếu vậy thì phải học cách sử dụng Excel chỉ 1 session thôi: mở Excel, Open file, hoặc vào recent file và open.
Như vậy code đơn giản như bài 2 thôi là ok.

Double tên file có những cái hại:
- Mở nhằm file virus giả danh
- Mở bằng Excel version không mong muốn (nếu cài 2 Office trở lên)
- Mở bằng 2 session nếu Option của Excel bị cài đặt (mà không biết đường sửa)
- ...

Mở bằng 2 session có những cái hại sau:
- Không tạo được Công thức liên kết giữa các file đang mở
- Không paste special được giữa 2 session
- Code bình thường không liệt kê file đang mở (topic này)
- Global code không chạy cho 2 session
- ...

Túm lại, làm việc đơn giản thì sẽ đơn giản.

ndu96081631 · 27/12/12

thanhlanh đã viết:
Vọc từ sáng giờ rốt cuộc cũng hoàn thiện được, không quá dài, gởi tặng mọi người.
Liệt kê được tất cả các File Excel đang mở trên tất cả các session, kể cả có dấu tiếng Việt.

Bài này có liên quan đến CÁC CỬA SỔ nên chợt nghĩ đến hàm EnumWindows và AddressOf Operator
Thử làm bài này theo phương án ấy xem:
1> Trong Module:

PHP:

Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Boolean
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextW" (ByVal hWnd As Long, ByVal lpString As Long, ByVal cch As Long) As Long
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthW" (ByVal hWnd As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Dic As Object

PHP:

Public Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Boolean
    Dim sSave As String, Ret As Long, wClass As String
    Ret = GetWindowTextLength(hWnd)
    sSave = Space(Ret)
    GetWindowText hWnd, StrPtr(sSave), Ret + 1
    wClass = WinClassName(hWnd)
    If (wClass = "MS-SDIb") Or (wClass = "XLMAIN") Then
      If sSave Like "Microsoft Excel - *" Then sSave = Mid(sSave, 19)
      sSave = Trim(Replace(sSave, "[Compatibility Mode]", ""))
      If Not Dic.Exists(sSave) Then Dic.Add sSave, ""
    End If
    EnumWindowsProc = True
End Function

PHP:

Function WinClassName(ByVal hWnd As Long) As String
  Dim RetVal As Long, lpClassName As String
  If hWnd <> 0 Then
    lpClassName = Space(256)
    RetVal = GetClassName(hWnd, lpClassName, 256)
    WinClassName = Left$(lpClassName, RetVal)
  End If
End Function

PHP:

Sub Main()
  Set Dic = CreateObject("Scripting.Dictionary")
  UserForm1.Show
End Sub

2> Trong UserForm (với 1 CommandButton và 1 ListBox)

PHP:

Private Sub CommandButton1_Click()
  On Error Resume Next
  EnumWindows AddressOf EnumWindowsProc, ByVal 0&
  Me.ListBox1.List() = Dic.Keys
End Sub

Hoàn toàn không có tí vòng lập nào hen
Giải thuật là:
- Cứ cửa số nào có ClassName = "XLMAIN" hoặc "MS-SDIb" thì lấy
- Lấy xong, xử lý các phần thừa để chỉ còn lại TÊN
Giải thuật là như vậy nhưng vì chưa rành API lắm, lại thông qua quá trình thí nghiệm mà suy luận nên phần triển khai có chút luộm thuộm
Rất mong các cao thủ góp ý, nhất là code trong hàm EnumWindowsProc (chưa hài lòng lắm)
Mình rất khoái thằng em "AddressOf" ---> Có vẽ như là 1 sự "tương tác 2 chiều gì đó" mà mình không mấy hiểu

thanhlanh · 28/12/12

ndu96081631 đã viết:
Bài này có liên quan đến CÁC CỬA SỔ nên chợt nghĩ đến hàm EnumWindows và AddressOf Operator
Thử làm bài này theo phương án ấy xem:

---------------
Code
---------------

Hoàn toàn không có tí vòng lập nào hen
Giải thuật là:
- Cứ cửa số nào có ClassName = "XLMAIN" hoặc "MS-SDIb" thì lấy
- Lấy xong, xử lý các phần thừa để chỉ còn lại TÊN
Giải thuật là như vậy nhưng vì chưa rành API lắm, lại thông qua quá trình thí nghiệm mà suy luận nên phần triển khai có chút luộm thuộm
Rất mong các cao thủ góp ý, nhất là code trong hàm EnumWindowsProc (chưa hài lòng lắm)
Mình rất khoái thằng em "AddressOf" ---> Có vẽ như là 1 sự "tương tác 2 chiều gì đó" mà mình không mấy hiểu

- Mở thử nhiều file trên nhiều session, test thử và thấy: Mỗi session chỉ liệt kê được một file, chắc là tại "Hoàn toàn không có tí vòng lập nào hen"

- Mình cũng mới vọc API nhưng lại khoái hàm FindWindowEx

siwtom · 28/12/12

thanhlanh đã viết:
- Mở thử nhiều file trên nhiều session, test thử và thấy: Mỗi session chỉ liệt kê được một file, chắc là tại "Hoàn toàn không có tí vòng lập nào hen"

Tôi kích hoạt 3 Excel 2007 và mỗi instance load 2 tập tin, tổng cộng 6 tập tin. Tìm được hết
Vui lòng nhìn hình.

View attachment 94757

Chỉ có điều "nho nhỏ", không cần test mà chỉ cần hình dung được trường hợp "cá biệt" khi đọc dòng
If Not Dic.Exists(sSave) Then Dic.Add sSave, ""
và tự hỏi: Thế nếu ...

Do ta đọc tiêu đề nên ta nhận được chỉ tên tập tin chứ không phải là tên đầy đủ - thay vì "C:\hic.xls" thì ta chỉ có "hic.xls".
Vậy nếu trong 2 instance ta mở 2 tập tin cùng tên (nhưng khác lõi) từ 2 thư mục khác nhau vd. thêm "D:\hic.xls" thì DIC sẽ bỏ 1 tên, tức ta bị mất 1 tên và ta không biết cái HIC nào đang được mở.
-----------
À, còn về code thì xin góp ý cho Tuấn thế này.
Thường thì ta chỉ có vài cửa sổ Excel đang mở, nhưng số cửa sổ mà EnumWindows "tìm thấy" sẽ nhiều hơn. Giả dụ tổng cộng sẽ tìm được 150 (tính khiêm tốn thôi chứ nhiều đấy, các bạn đếm sẽ biết) cửa sổ trong đó có 5 cửa sổ mà ta quan tâm - class MS-SDIb hoặc XLMAIN, tức hàm EnumWindowsProc được gọi 150 lần.
Như vậy cả cụm

Mã:

    Ret = GetWindowTextLength(hWnd)
    sSave = Space(Ret)
    GetWindowText hWnd, StrPtr(sSave), Ret + 1

được thực hiện 150 lần.
Nếu ta đưa cả cụm vào trong IF ... END IF thì tiết kiệm được 145 lần thực hiện cụm đó.
Chả lý gì ta thực hiện cụm 145 lần trong những trường hợp khi mà hWnd là handle của 145 cửa sổ mà ta không quan tâm.
Mà XLMAIN theo tôi có thể bỏ đi, tức chỉ có If (wClass = "MS-SDIb") Then

Kiểm tra tên các workbook đang mở để xác định 1 file đã mở hay chưa. (1 người xem)

Người dùng đang xem chủ đề này

Thành viên mới

❆❆❆❆❆❆❆❆

Thành viên mới

Huyền thoại GPE

Thành viên mới

Huyền thoại GPE

Thành viên mới

Huyền thoại GPE

❆❆❆❆❆❆❆❆

Thành viên mới

❆❆❆❆❆❆❆❆

Huyền thoại GPE

Huyền thoại GPE

Thành viên tích cực

Huyền thoại GPE

Thành viên tích cực

❆❆❆❆❆❆❆❆

Huyền thoại GPE

❆❆❆❆❆❆❆❆

Huyền thoại GPE

Thành viên tích cực

File đính kèm

Thành viên tích cực

Huyền thoại GPE

Bad Excel Member

Thành viên tích cực

❆❆❆❆❆❆❆❆

Bad Excel Member

Huyền thoại GPE

File đính kèm

Thành viên tích cực

Thành viên gắn bó

Thời gian đếm ngược.