我有一个例程,可以有效地粘贴指向用户已复制到剪贴板的一个或多个单元格的链接,在“ =”(个人可读性)后放置一个空格,并将锚点更改为-仅在粘贴之前。如果链接到另一个工作表,则字体将更改为蓝色。代码如下:
Sub QuickLink2()
' Copies a link,putting a space after the "=" and changing the
' anchoring to row-only. If the link is to another sheet, the
' font is changed to blue.
Dim r As Long, c As Long
Dim FormulaArr() As Variant
Dim Destination As Range
Application.ScreenUpdating = False
' Paste link
On Error Resume Next
ActiveSheet.Paste Link:=True
If Err.Number = 1004 Then GoTo NoSelection '1004 is a paste failure
On Error GoTo 0
' Transfer pasted link to array
If Selection.Cells.Count = 1 Then
ReDim FormulaArr(1 To 1, 1 To 1)
FormulaArr(1, 1) = Selection.Formula
Else
FormulaArr = Selection.Formula
End If
' Adjust formula spaces and anchoring
For r = 1 To UBound(FormulaArr, 1)
For c = 1 To UBound(FormulaArr, 2)
FormulaArr(r, c) = Replace(FormulaArr(r, c), "=", "= ")
FormulaArr(r, c) = Application.ConvertFormula _
(FormulaArr(r, c), xlA1, xlA1, xlAbsRowRelColumn)
Next c
Next r
Set Destination = Selection
Destination.Formula = FormulaArr
' Change font to blue if link is to another sheet
If Destination(1).Formula Like "*!*" Then _
Destination.Font.Color = RGB(0, 0, 255)
Exit Sub
NoSelection:
Application.CutCopyMode = False
End Sub
这里的想法是通过将粘贴的链接分配给变量数组,对数组进行必要的工作,然后将数组分配给范围来加快代码的速度。但是,我真正想做的是直接从剪贴板访问复制的单元格公式 ,然后将其分配给变量数组,而无需执行中间的ActiveSheet.Paste Link:=True
步骤。
以下代码将允许我获取复制的单元格 value ,但是,我当然在寻找复制的公式。
Dim DataObj As New MSForms.DataObject
Dim S As String
DataObj.GetFromClipboard
S = DataObj.GetText
答案 0 :(得分:0)
要获取公式:
Private Sub PutCellFormulaInClipBoard(ByVal Cell As Range)
Dim oDataObject As Object
Set oDataObject = _
GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
With oDataObject
.Clear
.SetText Cell.Cells(1).Formula
.PutInClipboard
End With
End Sub