Kiểm tra tên các workbook đang mở để xác định 1 file đã mở hay chưa. (2 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

Kiểm tra tên các workbook đang mở để xác định 1 file đã mở hay chưa. (2 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

Đếm ngược thời gian