Vincent88
Active Member
- Joined
- Mar 5, 2021
- Messages
- 382
- Office Version
- 2019
- Platform
- Windows
- Mobile
Hi Guys, my code is to copy the value of a cell to clipboard and a popup message box will show. I applied a timer to close the message box in 1 second but it does not work. Please review and help me to rectify it. Thanks.
VBA Code:
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim lrow As Long
Dim rngAreaC As Range, rngAreaD As Range
Dim strmgC As String, strmgD As String
Dim AckTime As Integer, InfoBox As Object
lrow = Range("A1").End(xlDown).Row
Application.ScreenUpdating = False
Application.EnableEvents = False
If Target.CountLarge > 1 Then Exit Sub
Set rngAreaC = Range(Cells(2, 3), Cells(lrow, 3))
Set rngAreaD = Range(Cells(2, 4), Cells(lrow, 4))
If Not Intersect(Target, rngAreaC) Is Nothing Then
Cancel = True
Target.Font.Bold = True
Target.Offset(, -2).Font.Bold = True
With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.SetText Target
.PutInClipboard
End With
strmgC = Target.Text & vbNewLine & _
vbCrLf & _
"Copied"
Set InfoBox = CreateObject("WScript.Shell")
AckTime = 1
Select Case InfoBox.Popup(strmgC, AckTime, "Notification", 0)
Case 1, -1
Exit Sub
End Select
Else
If Not Intersect(Target, rngAreaD) Is Nothing Then
Cancel = True
Target.Font.Bold = True
Target.Offset(, -2).Font.Bold = True
With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.SetText Target
.PutInClipboard
End With
strmgD = Target.Text & vbNewLine & _
vbCrLf & _
"Copied"
Set InfoBox = CreateObject("WScript.Shell")
AckTime = 1
Select Case InfoBox.Popup(strmgD, AckTime, "Notification", 0)
Case 1, -1
Exit Sub
End Select
End If
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub