Có đoạn code nào biến mọi thao tác dán thành Paste Values không?

[nghiaphuc]

Mình có làm một chương trình quản lý điểm cho trường và mình gặp một vấn đề như sau:
Trong bảng tính, mình đã định dạng nhất quán khung, nền, font chữ, cỡ chữ, CF,... rồi, nhưng khi giáo viên copy điểm từ file điểm cá nhân của họ vào chương trình (vì đây là chương trình dùng chung cho tất cả các môn, các lớp) thì những định dạng ban đầu của mình thường bị biến đổi. Mặc dù nó chẳng làm thay đổi gì chức năng của chương trình (trừ những thứ liên quan đến Validation) nhưng về mặt thẩm mỹ thì rất khó chịu.
Thực tế thì mình đã hướng dẫn rất nhiều lần về thao tác Paste Values, thậm chí mình còn kéo nút Paste Values lên thanh Menu và đặt phím tắt cho nó, nhưng có lẽ do thói quen khó bỏ nên thường thì giáo viên cứ nhấn nút Paste hoặc nhấn Ctrl+V để dán.
Vậy, xin hỏi: Liệu có đoạn code nào có thể biến mọi thao tác dán thành Paste Values không? Ít nhất là biến 2 thao tác: nhấn nút Paste và nhấn Ctrl+V thành Paste Values.
Rất mong nhận được câu trả lời của các anh, chị, em.
Xin chân thành cảm ơn!

 

[Hong.Van]

Các Thầy cho em hỏi, có cách nào để code ở modele kg? File có mấy chục Sheet & mỗi lần thêm sheet mới thì fải thêm sự kiện.
Em cảm ơn!

 

[Lê Duy Thương]

Các Thầy cho em hỏi, có cách nào để code ở modele kg? File có mấy chục Sheet & mỗi lần thêm sheet mới thì fải thêm sự kiện.
Em cảm ơn!

bạn thử làm theo hình xem

 

[Hong.Van]

Ý em là thế này, lấy ví dụ code của Thầy Siwtom ở bài #17

Sub PutDataToClipboard()
......................
.PutInClipboard
End With
End Sub

Code trên chép vào Module
Để code thực thi ở các sheet, thì ta fải chép code dưới vào tất cả các sheet

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.CutCopyMode Then PutDataToClipboard
End Sub

Như vậy có bao nhiêu Sheet thì fải chép code trên vào. Ý em nói có cách nào để khỏi chép vào nhiều Sheet?
Em cảm ơn

 

[ndu96081631]

Ý em là thế này, lấy ví dụ code của Thầy Siwtom ở bài #17

Sub PutDataToClipboard()
......................
.PutInClipboard
End With
End Sub

Code trên chép vào Module
Để code thực thi ở các sheet, thì ta fải chép code dưới vào tất cả các sheet

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.CutCopyMode Then PutDataToClipboard
End Sub

Như vậy có bao nhiêu Sheet thì fải chép code trên vào. Ý em nói có cách nào để khỏi chép vào nhiều Sheet?
Em cảm ơn

1> Code trong Module

Sub PutDataToClipboard()
  Dim Text As String
  On Error Resume Next
  With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    .GetFromClipboard
    Text = .GetText
    .Clear
    .SetText Text
    .PutInClipboard
  End With
End Sub

2> Code trong Thisworkbook

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  On Error Resume Next
  If Application.CutCopyMode Then PutDataToClipboard
End Sub

Vậy thôi

 

[ndu96081631]

Nhân đây xin đố mọi người 1 câu: Làm sao có thể xây dựng code trên thành 1 Add-In với các tính năng như sau:
- Khi Add-In được kích hoạt, lập tức sẽ có 1 button xuất hiện trên toolbar
- Khi nhấn vào Button, sự kiện PasteValue sẽ được khởi động
- Nhấn vào Button lần nữa sẽ tắt sự kiện PasteValue
------------------
Chưa làm nhưng tôi biết chắc là làm được. Các bạn thử xem nha!

 

[siwtom]

Nhân đây xin đố mọi người 1 câu: Làm sao có thể xây dựng code trên thành 1 Add-In với các tính năng như sau:
- Khi Add-In được kích hoạt, lập tức sẽ có 1 button xuất hiện trên toolbar
- Khi nhấn vào Button, sự kiện PasteValue sẽ được khởi động
- Nhấn vào Button lần nữa sẽ tắt sự kiện PasteValue
------------------
Chưa làm nhưng tôi biết chắc là làm được. Các bạn thử xem nha!

Tôi lười nên không test gì cả, còn hướng chắc là thế này:
Insert 1 class Module và 1 Module

clsExcelEvents:

Private WithEvents ExcelApp As Excel.Application

Private Sub Class_Terminate()
    Set ExcelApp = Nothing
End Sub

Public Sub DoCreate(ByVal ExcelApplication As Excel.Application)
    If ExcelApp Is Nothing Then Set ExcelApp = ExcelApplication
End Sub

Private Sub ExcelApp_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    If Not DoStandard And Application.CutCopyMode Then PutDataToClipboard
End Sub

Module

Public DoStandard As Boolean
Dim ExcelEvents As clsExcelEvents

Private Sub Auto_Open()
... tạo menu có Caption = "Paste Value", OnAction = "Hichic"
..
     Set ExcelEvents = New clsExcelEvents
     ExcelEvents.DoCreate Application
End Sub

Private Sub Auto_Close()
    xóa menu
    ...
     Set ExcelEvents = Nothing
End Sub

Private Sub Hichic()
     DoStandard = Not DoStandard
... đổi qua lại Caption thành "Standard Paste" hoặc "Paste Value"
End Sub

Sub PutDataToClipboard()
    Dim Text As String
    On Error Resume Next
    With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .GetFromClipboard
        Text = .GetText
        .Clear
        .SetText Text
        .PutInClipboard
    End With
End Sub

 

[ndu96081631]

Tôi lười nên không test gì cả, còn hướng chắc là thế này:
Insert 1 class Module và 1 Module

Em làm chắc cũng gần giống cái của anh
1> Class (clsExcelEvents)

Public WithEvents ExlApp As Application
Private Sub Class_Initialize()
  Set ExlApp = Application
End Sub

Private Sub Class_Terminate()
  Set ExlApp = Nothing
End Sub

Private Sub ExlApp_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  On Error Resume Next
  If Application.CutCopyMode Then PutDataToClipboard
End Sub

2> Module

Dim ExlObj As New clsExcelEvents
Sub Event_Start()
  If ExlObj Is Nothing Then Set ExlObj = New clsExcelEvents
  With Application.CommandBars(1).Controls("Start Paste Values")
    .Caption = "Reset"
    .OnAction = "Event_Stop"
    .FaceId = 47
  End With
End Sub

Sub Event_Stop()
  Set ExlObj = Nothing
  With Application.CommandBars(1).Controls("Reset")
    .Caption = "Start Paste Values"
    .OnAction = "Event_Start"
    .FaceId = 22
  End With
End Sub

Sub PutDataToClipboard()
  Dim Text As String
  On Error Resume Next
  With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    .GetFromClipboard
    Text = .GetText
    .Clear
    .SetText Text
    .PutInClipboard
  End With
End Sub

Sub Auto_Open()
  On Error Resume Next
  With Application.CommandBars(1)
    .Reset
    With .Controls.Add(1)
      .Caption = "Start Paste Values"
      .OnAction = "Event_Start"
      .FaceId = 22
    End With
  End With
End Sub

Sub Auto_Close()
  On Error Resume Next
  Event_Stop
  Application.CommandBars(1).Reset
End Sub

Ai đang dùng Excel 2003 test giùm file này với nhé

 

[thanhlanh]

Nhân đây xin đố mọi người 1 câu: Làm sao có thể xây dựng code trên thành 1 Add-In với các tính năng như sau:
- Khi Add-In được kích hoạt, lập tức sẽ có 1 button xuất hiện trên toolbar
- Khi nhấn vào Button, sự kiện PasteValue sẽ được khởi động
- Nhấn vào Button lần nữa sẽ tắt sự kiện PasteValue
------------------
Chưa làm nhưng tôi biết chắc là làm được. Các bạn thử xem nha!

Triển khai theo hướng của Anh siwtom


Class

Private WithEvents ExcelApp As Excel.Application 
Private Sub Class_Terminate()
    Set ExcelApp = Nothing
End Sub
Public Sub DoCreate(ByVal ExcelApplication As Excel.Application)
    If ExcelApp Is Nothing Then Set ExcelApp = ExcelApplication
End Sub
Private Sub ExcelApp_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    If Application.CutCopyMode Then PasteFromClipboard
End Sub

Module

Public Bool As Boolean, ItemButton As Integer
Dim ExcelEvents As clsExcelEvents
Sub Auto_Open()
    On Error Resume Next
    ItemButton = Application.CommandBars("Standard").Controls.Count + 1
    Application.CommandBars("Standard").Controls.Add Type:=msoControlButton, ID _
                                                                           :=18, Before:=ItemButton, Parameter:=True, temporary:=True
    With Application.CommandBars("Standard").Controls.Item(ItemButton)
        .OnAction = "SetButton"
        .TooltipText = "Exit Paste to Paste Value"
        .FaceId = 59
        .Caption = "GPE"
    End With
    Set ExcelEvents = New clsExcelEvents
    ExcelEvents.DoCreate Application
End Sub
Sub SetButton()
    'ItemButton = Application.CommandBars("Standard").Controls.Count
    Bool = Application.CommandBars("Standard").Controls("GPE").Parameter
    Bool = Not (Bool)
   Application.CommandBars("Standard").Controls("GPE").Parameter = Bool
    If Bool Then
        TooltipButton = "Exit Paste to Paste Value"
    Else
        TooltipButton = "Set Paste to Paste Value"
        CreateObject("HTMLfile").ParentWindow.ClipboardData.SetData "text", ""
    End If
   Application.CommandBars("Standard").Controls("GPE").TooltipText = TooltipButton
End Sub
Sub PasteFromClipboard()
    Bool = Application.CommandBars("Standard").Controls("GPE").Parameter
    If Bool = False Then Exit Sub
    Dim objData As Object, sData As String
    On Error Resume Next
    Set objData = CreateObject("HTMLfile")
    sData = objData.ParentWindow.ClipboardData.GetData("text")
    objData.ParentWindow.ClipboardData.SetData "text", Chr(32) & sData
    Set objData = Nothing
End Sub
Sub Auto_Close()
    Set ExcelEvents = Nothing
    Application.CommandBars("Standard").Controls("GPE").Delete
End Sub

 

[Hoàng Trọng Nghĩa]

Em làm chắc cũng gần giống cái của anh...

Khi Paste phải chuyển qua chế độ "cục gôm" thì mới có thể dùng Paste value được, nhưng hình như vẫn chưa hoàn hảo.

Khi chuyển qua cục gôm thì nó paste value, khi chuyển lại nó cũng paste value, lẽ ra khi chuyển lại: hoặc nó mất paste (CutCopyMode=False) hoặc phải paste toàn bộ nội dung copy (value, format...).

 

[ndu96081631]

Khi chuyển qua cục gôm thì nó paste value, khi chuyển lại nó cũng paste value, lẽ ra khi chuyển lại: hoặc nó mất paste (CutCopyMode=False) hoặc phải paste toàn bộ nội dung copy (value, format...).

Khi bấm nút để reset, đương nhiên bạn phải copy lại cái mới thì mới paste được bình thường chứ
Để nguyên vậy sao mà paste được ---> clipboard đã bị nạp thứ khác rồi (xem code tự hiểu nhé)

 

[Hoàng Trọng Nghĩa]

Khi bấm nút để reset, đương nhiên bạn phải copy lại cái mới thì mới paste được bình thường chứ
Để nguyên vậy sao mà paste được ---> clipboard đã bị nạp thứ khác rồi (xem code tự hiểu nhé)

Vì vậy nên chỉ cần thêm Application.CutCopyMode=False sau khi bấm reset để bắt buộc người ta thấy nút paste chìm xuống thì tự nhiên người ta copy lại thôi. Chứ nó vẫn cứ trơ trơ người ta lại paste tiếp. Ý em là vậy mà!

 

[ndu96081631]

Vì vậy nên chỉ cần thêm Application.CutCopyMode=False sau khi bấm reset để bắt buộc người ta thấy nút paste chìm xuống thì tự nhiên người ta copy lại thôi. Chứ nó vẫn cứ trơ trơ người ta lại paste tiếp. Ý em là vậy mà!

Thêm sao? Hổng ấy Nghĩa thêm vào code rồi đưa lên đây tôi xem thử

 

[pro8x]

Đúng bài em cần. Bác nào cho em hỏi thêm 1 chút. Có code nào mà sau khi Paste Values vào 1 cột thì cột đó fix luôn không thay đổi được nữa không ah

 

[Hoàng Trọng Nghĩa]

Thêm sao? Hổng ấy Nghĩa thêm vào code rồi đưa lên đây tôi xem thử

Dĩ nhiên em chỉ góp ý, chứ chưa biết phải thêm ở đâu:

Ta thêm 1 biến Boolean, isReset chẳng hạn khi ta bấm nút Reset thì nó trả về True rồi trong thủ tục clipboar ta cho nó nó ".Clear" nội dung rồi trả về isReset=False lại. Hoặc dùng thủ tục CommandBars("Paste").Enable = False để không cho Paste nữa v.v...

Chỉ là gợi ý chứ trình độ của Thầy em biết là có thể biến chuyển để thực hiện được điều đó.

 

[ndu96081631]

Dĩ nhiên em chỉ góp ý, chứ chưa biết phải thêm ở đâu:

Ta thêm 1 biến Boolean, isReset chẳng hạn khi ta bấm nút Reset thì nó trả về True rồi trong thủ tục clipboar ta cho nó nó ".Clear" nội dung rồi trả về isReset=False lại. Hoặc dùng thủ tục CommandBars("Paste").Enable = False để không cho Paste nữa v.v...

Chỉ là gợi ý chứ trình độ của Thầy em biết là có thể biến chuyển để thực hiện được điều đó.

Nếu muốn vậy thì Nghĩa dùng API mà làm, chẳng hạn:

Sub Event_Stop()
  Set ExlObj = Nothing
  With Application.CommandBars(1).Controls("Reset")
    .Caption = "Start Paste Values"
    .OnAction = "Event_Start"
    .FaceId = 22
  End With
[COLOR=#ff0000]  OpenClipboard (0&)
  EmptyClipboard
  CloseClipboard[/COLOR]
End Sub

Cái màu đỏ là 3 hàm API
Nói chung là tôi thấy cũng chẳng quan trọng gì (chỉ là râu ria)

 

[Hoàng Trọng Nghĩa]

Nếu muốn vậy thì Nghĩa dùng API mà làm, chẳng hạn:

Sub Event_Stop()
  Set ExlObj = Nothing
  With Application.CommandBars(1).Controls("Reset")
    .Caption = "Start Paste Values"
    .OnAction = "Event_Start"
    .FaceId = 22
  End With
[COLOR=#ff0000] [B] OpenClipboard (0&)[/B]
[/COLOR]  EmptyClipboard
  CloseClipboard
End Sub

Cái màu đỏ là 3 hàm API
Nói chung là tôi thấy cũng chẳng quan trọng gì (chỉ là râu ria)

Sao em bấm nút nó báo lỗi tại dòng màu đỏ vậy Thầy? (Sub or Function not defined)

 

[ndu96081631]

Sao em bấm nút nó báo lỗi tại dòng màu đỏ vậy Thầy? (Sub or Function not defined)

Trời ơi!
Thế trong code đã có 3 hàm này chưa:

Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function EmptyClipboard Lib "user32.dll" () As Long
Public Declare Function CloseClipboard Lib "user32" () As Long

Phải tự cho vào chứ

 

[Hoàng Trọng Nghĩa]

Trời ơi!
Thế trong code đã có 3 hàm này chưa:

Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function EmptyClipboard Lib "user32.dll" () As Long
Public Declare Function CloseClipboard Lib "user32" () As Long

Phải tự cho vào chứ

Trời, sao em biết được chứ! Thầy đưa lên thứ gì thì xài thứ đó thôi. Em chỉ là người "test hộ" thôi à! hahahaha

Kết quả sau khi có đầy đủ 3 hàm API vừa rồi thì đúng như ý đồ là sau khi reset thì chỉ có copy lại mới paste được thôi.

Great!!!

 

[ndu96081631]

Trời, sao em biết được chứ! Thầy đưa lên thứ gì thì xài thứ đó thôi. Em chỉ là người "test hộ" thôi à! hahahaha

Ở trên đã nói rõ rồi còn gì

Cái màu đỏ là 3 hàm API

Thậm chỉ code ở trên cũng tô màu để gây chú ý luôn rồi
Ẹc...Ẹc...
-------------
Ah, mà Nghĩa test trên Excel nào vậy? Nếu dùng Excel 2003, có thể vui lòng chụp hình cái menu ấy post lên đây cho tôi nhìn thấy hình dáng nó ra làm sao được không?
(dùng Excel 2010 nên không hình dùng được với Excel 2003 thì cái menu ấy nó thế nào nữa)

 

[Hoàng Trọng Nghĩa]

Ở trên đã nói rõ rồi còn gì

Thậm chỉ code ở trên cũng tô màu để gây chú ý luôn rồi
Ẹc...Ẹc...
-------------
Ah, mà Nghĩa test trên Excel nào vậy? Nếu dùng Excel 2003, có thể vui lòng chụp hình cái menu ấy post lên đây cho tôi nhìn thấy hình dáng nó ra làm sao được không?
(dùng Excel 2010 nên không hình dùng được với Excel 2003 thì cái menu ấy nó thế nào nữa)

Test trên 2003 Thầy ơi:




===============================================

To Admin: dạo này sao chuyển hình lên đây bằng nút Insert Image sao không được (From URL), để ý rất nhiều lần trong thời gian gần đây rồi!