首页 文章

从Excel VBA中的剪贴板中获取复制的公式

提问于
浏览 334
0

我有一个例程,可以有效地粘贴一个或多个用户复制到剪贴板的单元格的链接,在“=”之后放置一个空格(个人偏好,为了便于阅读),并在粘贴之前将锚定更改为仅行 . 如果链接是另一个工作表,则字体将更改为蓝色 . 代码如下:

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 步骤的情况下分配给变量数组 .

下面的代码将允许我获取复制的单元格值,但当然我正在寻找复制的公式 .

Dim DataObj As New MSForms.DataObject
Dim S As String
DataObj.GetFromClipboard
S = DataObj.GetText

1 回答

  • 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
    

    Ref

相关问题