Đếm chuỗi từ trong Clipboard

[bun_bo_hue]

Chào các bác. Mình có 1 nhu cầu đếm chuỗi từ Clipboard trong Excel như sau :
- Khi copy (nhấn Ctrl-C or lệnh COPY) 1 đọan TEXT (và chỉ TEXT mà thôi) từ trong Excel hay 1 chương trình nào khác.
- Vô EXCEL chạy 1 lệnh macro để đếm được tổng số kí tự có trong Clipboard mà không cần phải PASTE.

Em mò mẩm trong HELP hoài không ra. Mong các pác chỉ giúp ạ.

Cám ơn rất nhiều.

 

[ndu96081631]

Chào các bác. Mình có 1 nhu cầu đếm chuỗi từ Clipboard trong Excel như sau :
- Khi copy (nhấn Ctrl-C or lệnh COPY) 1 đọan TEXT (và chỉ TEXT mà thôi) từ trong Excel hay 1 chương trình nào khác.
- Vô EXCEL chạy 1 lệnh macro để đếm được tổng số kí tự có trong Clipboard mà không cần phải PASTE.

Em mò mẩm trong HELP hoài không ra. Mong các pác chỉ giúp ạ.

Cám ơn rất nhiều.

Xem cái này trong Help



Đủ để giải quyết vấn đề rồi, dựa vào chổ này

MyData.GetFromClipboard 
Cái gì đó = MyData.GetText(1)

 

[ndu96081631]

Code ở trên bắt buộc phải dùng với UserForm hoặc ít nhất cũng phải check vào "Microsoft Forms 2.0 Object Library" trong References
Vậy nhân đây xin đố các bạn 1 vấn đề nhỏ: Nếu người ta không muốn dùng UserForm đồng thời cũng chẳng thích gọi thư viện FM20 thì code phải sửa thế nào?
Ẹc... Ẹc...

 

[thanhlanh]

Code ở trên bắt buộc phải dùng với UserForm hoặc ít nhất cũng phải check vào "Microsoft Forms 2.0 Object Library" trong References
Vậy nhân đây xin đố các bạn 1 vấn đề nhỏ: Nếu người ta không muốn dùng UserForm đồng thời cũng chẳng thích gọi thư viện FM20 thì code phải sửa thế nào?
Ẹc... Ẹc...

Vầy được không? (195 ký tự)

Private Sub LenTextClipboard()
    Dim MyData As DataObject, myText
    Set MyData = New DataObject
    MyData.GetFromClipboard
    myText = MyData.GetText(1)
    MsgBox Len(myText)
End Sub

Hồi chiều ndu quá khen, cũng là học từ bạn và mọi người thôi!

 

[ndu96081631]

Vầy được không? (195 ký tự)

Private Sub LenTextClipboard()
    Dim MyData As DataObject, myText
    Set MyData = New DataObject
    MyData.GetFromClipboard
    myText = MyData.GetText(1)
    MsgBox Len(myText)
End Sub

Hồi chiều ndu quá khen, cũng là học từ bạn và mọi người thôi!

Với code này, nếu trên máy anh vẫn chạy được thì anh hãy vào menu Tools\References, bỏ dấu check ở mục "Microsoft Forms x.x Object Library" rồi chạy lại code xem thử nhé




Còn không thì anh cứ copy đoạn code của anh, paste vào Module của 1 wb trắng và thử xem

 

[thanhlanh]

Bó tay rồi
Nếu ở file đó mình xóa dấu check nó ko cho (mình đang mở file có nguồn gốc là của ndu sẵn đó thí nghiệm luôn)
Mở file khác không có dòng đó để mà check, --> code báo lỗi.
Tại sao vậy và phải giải quyết ntn?

 

[ndu96081631]

Bó tay rồi
Nếu ở file đó mình xóa dấu check nó ko cho (mình đang mở file có nguồn gốc là của ndu sẵn đó thí nghiệm luôn)
Mở file khác không có dòng đó để mà check, --> code báo lỗi.
Tại sao vậy và phải giải quyết ntn?

DataObject thuộc thư viện FM20 (Microsoft Forms x.x Object Library) ---> Vì thế hổng check vào thì code báo lỗi là đương nhiên (lúc đó nó đâu có biết DataObject là cái giống gì)
Tuy nhiên vẫn có cách CreateObject(... gì gì đó...) ---> Để chi vậy? Để bất ký ai copy code của mình về chạy đều khỏi quan tâm đến các thư viện trong References
-------------------------------------------------
Với mọi vấn đề thú vị, em luôn "đào bới" đến khi nào tìm thấy "nước" mới thôi... Chịu khó đi anh, thời đại công nghệ thông tin, google 1 phát là ra ngay mà (nói thật, em vừa mới google và cũng vừa mới biết cách đây 10 phút)
Ẹc... Ẹc...

 

[bun_bo_hue]

DataObject thuộc thư viện FM20 (Microsoft Forms x.x Object Library) ---> Vì thế hổng check vào thì code báo lỗi là đương nhiên (lúc đó nó đâu có biết DataObject là cái giống gì)
Tuy nhiên vẫn có cách CreateObject(... gì gì đó...) ---> Để chi vậy? Để bất ký ai copy code của mình về chạy đều khỏi quan tâm đến các thư viện trong References
-------------------------------------------------
Với mọi vấn đề thú vị, em luôn "đào bới" đến khi nào tìm thấy "nước" mới thôi... Chịu khó đi anh, thời đại công nghệ thông tin, google 1 phát là ra ngay mà (nói thật, em vừa mới google và cũng vừa mới biết cách đây 10 phút)
Ẹc... Ẹc...

Vậy có cách nào làm không bác NDU. Chỉ em với ạ.

 

[ndu96081631]

Vậy có cách nào làm không bác NDU. Chỉ em với ạ.

Tặng bạn 2 loại code, 1 dùng DataObject và 1 dùng API
1> Dùng DataObject

Sub GetDataFormClipboard()
  On Error Resume Next
  With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    .GetFromClipboard
    MsgBox .GetText
  End With
End Sub

2> Dùng API

Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Long, ByVal ByteLen As Long)

Sub GetDataFormClipboard()
  Dim hStrPtr As Long, lLength As Long, sBuffer As String
  OpenClipboard Application.hwnd
  hStrPtr = GetClipboardData(1)
  If hStrPtr <> 0 Then
    lLength = lstrlen(hStrPtr)
    If lLength > 0 Then
      sBuffer = Space$(lLength)
      CopyMemory ByVal sBuffer, ByVal hStrPtr, lLength
      MsgBox sBuffer, vbInformation
    End If
  End If
  CloseClipboard
End Sub

Tuy ý sử dụng nhé

 

[thanhlanh]

Tặng bạn 2 loại code, 1 dùng DataObject và 1 dùng API
1> Dùng DataObject

Sub GetDataFormClipboard()
  On Error Resume Next
  With CreateObject("new:{[COLOR=red]1C3B4210-F441-11CE-B9EA-00AA006B1A69[/COLOR]}")
    .GetFromClipboard
    MsgBox .GetText
  End With
End Sub
[/QUOTE]
 Cái đỏ đỏ ở trên là cái chi mà nhìn hoa cả mắt vậy Thầy?
Có phải là chữ Clipboard dịch sang hệ rhập lục phân không?

 

[ndu96081631]

Cái đỏ đỏ ở trên là cái chi mà nhìn hoa cả mắt vậy Thầy?
Có phải là chữ Clipboard dịch sang hệ rhập lục phân không?

Cái đó tìm thấy trong Registry




Ngoài ra mọi thứ có tìm bằng Google anh à

 

[bun_bo_hue]

Tặng bạn 2 loại code, 1 dùng DataObject và 1 dùng API
1> Dùng DataObject

Sub GetDataFormClipboard()
  On Error Resume Next
  With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    .GetFromClipboard
    MsgBox .GetText
  End With
End Sub

2> Dùng API

Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Long, ByVal ByteLen As Long)

Sub GetDataFormClipboard()
  Dim hStrPtr As Long, lLength As Long, sBuffer As String
  OpenClipboard Application.hwnd
  hStrPtr = GetClipboardData(1)
  If hStrPtr <> 0 Then
    lLength = lstrlen(hStrPtr)
    If lLength > 0 Then
      sBuffer = Space$(lLength)
      CopyMemory ByVal sBuffer, ByVal hStrPtr, lLength
      MsgBox sBuffer, vbInformation
    End If
  End If
  CloseClipboard
End Sub

Tuy ý sử dụng nhé

Cám ơn bác NDU nhiều lắm ạ.