Windows 11, mọi phiên bản Office bị Lỗi copy data Vào Clipboard

quyenpv · 9/1/22

Kính gửi anh chị trên diễn đàn
Hiện có 1 lỗi rất khó chịu khi dùng Excel (mọi phiên bản) trên Windows 11 đều bị lỗi dataobject: putinclipboard rất khó chịu khi dùng copy dữ liệu vào clipboard để dùng, đã tìm google đủ kiểu vẫn không sửa được. Mong các anh chị giúp để những ai dùng Windows 11 mà không cần cài máy ảo để chạy Win phiên bản thấp hơn chỉ mỗi việc dùng 1 đoạn code phụ thuộc vào Clipboard
VD như Topic này Thay thế từ khoá Excel sang Word
Bài hướng dẫn của Microsoft cũng không được ạ

Sử dụng chức năng Copy Clipboard ra toàn dấu ??? hoặc ô vuông ạ
Mong anh chị xem và fix giúp

batman1 · 9/1/22

quyenpv đã viết:
Hiện có 1 lỗi rất khó chịu khi dùng Excel (mọi phiên bản) trên Windows 11 đều bị lỗi dataobject: putinclipboard rất khó chịu khi dùng copy dữ liệu vào clipboard để dùng, đã tìm google đủ kiểu vẫn không sửa được.

Bài hướng dẫn của Microsoft cũng không được ạ

1. Chèn thêm module1 và dán code sau vào Module1

Mã:

Option Explicit

Private Const CF_UNICODETEXT = 13
Private Const GMEM_MOVEABLE As Long = &H2
Public Const GMEM_ZEROINIT = &H40

#If VBA7 Then
    Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
    Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
    Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
    Private Declare PtrSafe Function GlobalFree Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
    Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#Else
    Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
    Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
    Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
    Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function CloseClipboard Lib "user32" () As Long
    Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
    Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
#End If

Sub TextToClipboard(ByVal text As String)
#If VBA7 Then
    Dim hGlobal As LongPtr, lpString As LongPtr
#Else
    Dim hGlobal As Long, lpString As Long
#End If

    OpenClipboard 0
    EmptyClipboard
    
    hGlobal = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, LenB(text) + 2)
    lpString = GlobalLock(hGlobal)

    CopyMemory ByVal lpString, ByVal StrPtr(text), LenB(text) + 2
    GlobalUnlock hGlobal
    SetClipboardData CF_UNICODETEXT, hGlobal
    CloseClipboard
    GlobalFree hGlobal
End Sub

2. Trong UserForm thay bằng code mới

Mã:

Private Sub cmdCopy_Click()
    TextToClipboard Me.imageMso.Caption
    Me.Hide
End Sub

quyenpv · 9/1/22

Dạ cám ơn anh batman1
Nếu trường hợp này thì muốn sử dụng code anh thì sửa hay thêm đoạn nào ạ Tối ưu lại Code thay thế từ Excel sang Word mong anh giúp đỡ ạ. Vì công việc của em hay phải xuất dữ liệu qua lại, mỗi lần cần lại qua máy ảo rất cực ạ (cài thử windows 11 nó chạy nhanh hơn Win 10 ạ)

Mã:

Public Sub FindAndReplace(ByVal strFind As String, ByVal strReplace As String)
    Dim dataObj     As MSForms.DataObject
    Set dataObj = New MSForms.DataObject
    'Dim dataObj As New MSForms.DataObject
    dataObj.SetText strReplace
    dataObj.PutInClipboard
    wdApp.Selection.GoTo What:=wdGoToSection, which:=wdGoToFirst    ' Go to the start of the document
    With wdApp.Selection.Find
        .ClearFormatting
        .MatchCase = True
        .MatchWholeWord = True
        .Text = strFind
        .Replacement.ClearFormatting
        .Replacement.Text = "^c"
        .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
    End With
    Set dataObj = Nothing
End Sub

batman1 · 9/1/22

quyenpv đã viết:
Dạ cám ơn anh batman1
Nếu trường hợp này thì muốn sử dụng code anh thì sửa hay thêm đoạn nào ạ Tối ưu lại Code thay thế từ Excel sang Word mong anh giúp đỡ ạ. Vì công việc của em hay phải xuất dữ liệu qua lại, mỗi lần cần lại qua máy ảo rất cực ạ (cài thử windows 11 nó chạy nhanh hơn Win 10 ạ)

Mã:

Public Sub FindAndReplace(ByVal strFind As String, ByVal strReplace As String) Dim dataObj As MSForms.DataObject Set dataObj = New MSForms.DataObject 'Dim dataObj As New MSForms.DataObject dataObj.SetText strReplace dataObj.PutInClipboard wdApp.Selection.GoTo What:=wdGoToSection, which:=wdGoToFirst ' Go to the start of the document With wdApp.Selection.Find .ClearFormatting .MatchCase = True .MatchWholeWord = True .Text = strFind .Replacement.ClearFormatting .Replacement.Text = "^c" .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue End With Set dataObj = Nothing End Sub

Ở bài 1 bạn kêu là dataobject bị lỗi trên Windows 11. Tôi không có Windows 11 để kiểm tra. Nhưng bạn nói là API cũng không giúp được gì thì tôi viết API cho bạn. Mục đích là thay dataobject bằng TextToClipboard. Vậy thì khi nào bạn muốn "đập" text vào Clipboard thì gọi sub TextToClipboard thôi. Code ở đâu, chèn như thế thế nào thì tôi hướng dẫn rồi.

Trong sub FindAndReplace
thay

Mã:

Dim dataObj     As MSForms.DataObject
    Set dataObj = New MSForms.DataObject
    'Dim dataObj As New MSForms.DataObject
    dataObj.SetText strReplace
    dataObj.PutInClipboard

bằng

Mã:

TextToClipboard strReplace

Tuy nhiên trong Sub Export_HSPly được gán cho Button có

Mã:

Set wDoc = wdApp.Documents.Open(strPath, ReadOnly:=True)

Muốn chỉnh sửa tập tin Word mà lại mở ở chế độ chỉ Đọc, chỉ Xem thì hơi lạ.

HeSanbi · 9/1/22

@quyenpv
Bạn dùng thư viện htmlfile cho gọn nhẹ:

VBA.CreateObject("htmlfile").parentWindow.clipboardData.setData "text", strReplace

quyenpv · 9/1/22

batman1 đã viết:
Ở bài 1 bạn kêu là dataobject bị lỗi trên Windows 11. Tôi không có Windows 11 để kiểm tra. Nhưng bạn nói là API cũng không giúp được gì thì tôi viết API cho bạn. Mục đích là thay dataobject bằng TextToClipboard. Vậy thì khi nào bạn muốn "đập" text vào Clipboard thì gọi sub TextToClipboard thôi. Code ở đâu, chèn như thế thế nào thì tôi hướng dẫn rồi.

Trong sub FindAndReplace
thay

Mã:

Dim dataObj As MSForms.DataObject Set dataObj = New MSForms.DataObject 'Dim dataObj As New MSForms.DataObject dataObj.SetText strReplace dataObj.PutInClipboard

bằng

Mã:

TextToClipboard strReplace

Tuy nhiên trong Sub Export_HSPly được gán cho Button có

Mã:

Set wDoc = wdApp.Documents.Open(strPath, ReadOnly:=True)

Muốn chỉnh sửa tập tin Word mà lại mở ở chế độ chỉ Đọc, chỉ Xem thì hơi lạ.

Dạ em làm dạng Template sau khi thay thế xong sẽ lưu thành file khác ạ

quyenpv · 9/1/22

batman1 đã viết:
Ở bài 1 bạn kêu là dataobject bị lỗi trên Windows 11. Tôi không có Windows 11 để kiểm tra. Nhưng bạn nói là API cũng không giúp được gì thì tôi viết API cho bạn. Mục đích là thay dataobject bằng TextToClipboard. Vậy thì khi nào bạn muốn "đập" text vào Clipboard thì gọi sub TextToClipboard thôi. Code ở đâu, chèn như thế thế nào thì tôi hướng dẫn rồi.

Trong sub FindAndReplace
thay

Mã:

Dim dataObj As MSForms.DataObject Set dataObj = New MSForms.DataObject 'Dim dataObj As New MSForms.DataObject dataObj.SetText strReplace dataObj.PutInClipboard

bằng

Mã:

TextToClipboard strReplace

Tuy nhiên trong Sub Export_HSPly được gán cho Button có

Mã:

Set wDoc = wdApp.Documents.Open(strPath, ReadOnly:=True)

Muốn chỉnh sửa tập tin Word mà lại mở ở chế độ chỉ Đọc, chỉ Xem thì hơi lạ.

Dạ cám ơn anh nhiều! Code chạy tốt ạ đỡ cho em nhiều quá, cám ơn anh

Windows 11, mọi phiên bản Office bị Lỗi copy data Vào Clipboard

quyenpv

Thu nhặt kiến thức

File đính kèm

batman1

Thành viên gạo cội

quyenpv

Thu nhặt kiến thức

File đính kèm

batman1

Thành viên gạo cội

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

quyenpv

Thu nhặt kiến thức

quyenpv

Thu nhặt kiến thức

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng