applacation.calculate，在selectionchange事件中，不能粘贴 求解

applacation.calculate，在selectionchange事件中，不能粘贴 求解

Excel2003中如果你在"Worksheet_SelectionChange"事件中写了VBA代码的话粘贴功能就会失效.还没有一个很好的解决方案，据说是2003的Bug，下面的代码可以暂时解决这个问题，不过这个代码本身有一些小Bug:整行选的话会报错，把它catch掉就可以了:-）。
但是对正常使用不会有太大影响。
There is a temp solution for this problem:
//------------------------------------------------------------------------------------
Extra code in Worksheet_SelectionChange:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo err
'/错误处理，发生异常时转到err
Dim rngCutCopy As Range
Dim iCutCopymode As Integer
If CutCopyMode Then
Set rngCutCopy = CutCopyRange
Else
Set rngCutCopy = Nothing
End If
iCutCopymode = CutCopyMode
//Your Code

If iCutCopymode = xlCopy Then
rngCutCopy.Copy
ElseIf iCutCopymode = xlCut Then
rngCutCopy.Cut
End If
err:
'/异常时不做任何处理，只是为了屏蔽对话框
End Sub
//-------------------------------------------------------------------------------
Extra code in modules
Option Explicit
'/锁定内存中指定的内存块,并返回一个地址值,令其指向内存块的起始处
Private Declare Function GlobalLock _
Lib "kernel32" ( _
ByVal hMem As Long) _
As Long
'/解锁先前被锁定的内存,使得指向内存块的指针无效
Private Declare Function GlobalUnlock _
Lib "kernel32" ( _
ByVal hMem As Long) _
As Long
'/得到的是内存块的大小
Private Declare Function GlobalSize _
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 GetClipboardData _
Lib "user32" ( _
ByVal wFormat As Long) _
As Long
'/将一块内存的数据从一个位置复制到另一个位置
Private Declare Sub CopyMemory _
Lib "kernel32" _
Alias "RtlMoveMemory" ( _
Destination As Any, _
Source As Any, _
ByVal Length As Long)
'//--------------------------------------------------------------------------------------//
'//-----用于取得处于复制或者剪切状态的单元格区域的函数------//
'//--------------------------------------------------------------------------------------//
Public Function CutCopyRange () As Range
On Error GoTo Hanlder
Dim bytData() As Byte, hMem As Long, nClipsize As Long, lpData As Long
Dim sSource As String, sTemp() As String
Dim sWorkbook As String, sSheet As String, sRange As String
'/打开剪切板
OpenClipboard 0&
'/取得剪切板中有关Excel单元格复制的信息数据
hMem = GetClipboardData (49154)
'/假如存在数据
If CBool(hMem) Then
'/取得数据内存的大小
nClipsize = GlobalSize (hMem)
'/锁定此内存块，并返回内存块的起始地址
lpData = GlobalLock (hMem)
If lpData <> 0 Then
'/从新定义数组大小
ReDim bytData(0 To nClipsize - 1) As Byte
'/将内存复制到数组中
CopyMemory bytData(0), ByVal lpData, nClipsize
'/将二进制数组转换成字符串
sSource = StrConv (bytData, vbUnicode)
'/拆分字符串
sTemp = Split(sSource, Chr(0))
'/假使在拆分得到的字符串2中找到"\"（即工作薄已经保存）
If InStr (sTemp(1), "\") Then
'/取得工作薄的名称
sWorkbook = Mid(sTemp(1), InStrRev (sTemp(1), "\") + 1)
Else
'/取得工作薄的名称
sWorkbook = sTemp(1)
End If
'/取得工作表的名称
sSheet = Left(sTemp(2), InStr (sTemp(2), "!") - 1)
'/取得单元格区域的地址
sRange = R1C1 _To_A1(Mid(sTemp(2), InStr (sTemp(2), "!") + 1))
'/取得处于剪切或者复制状态的单元格
Set CutCopyRange = Workbooks(sWorkbook).Sheets(sSheet).Range(sRange)
End If
'/解锁 内存
GlobalUnlock hMem

'/假如未处于复制或者剪切状态
Else
Set CutCopyRange = Nothing
End If
'/关闭剪切板
CloseClipboard
Exit Function
Hanlder:
Debug.Print err.Number & err.Description
End Function
'//--------------------------------------------------------------------------
'//----用于将单元格的R1C1引用样式转换为A1样式------
'//--------------------------------------------------------------------------
Private Function R1C1 _To_A1(RgStr As String) As String
Dim sTemp() As String
If InStr (RgStr , ":") Then
sTemp = Split(RgStr , ":")
R1C1 _To_A1 = R1C1 _To_A1(sTemp(0)) & ":" & R1C1 _To_A1(sTemp(1))
Else
RgStr = Mid(RgStr , 2)
sTemp = Split(RgStr , "C")
R1C1 _To_A1 = Chr(64 + sTemp(1)) & sTemp(0)
End If
End Function

是啊， 你在用 单元格对应行列 高亮显示？