时间戳

首页 > 解决方案 > 我正在尝试创建一个宏，该宏将范围与范围中的对象一起复制并粘贴到新变量位置

excel - 我正在尝试创建一个宏，该宏将范围与范围中的对象一起复制并粘贴到新变量位置

问题描述

我的意图是将一个范围与对象（单选按钮）一起复制并将其粘贴到动态位置（偏移 15 列），然后更新新粘贴对象相对于它们的位置的所有单元格引用。即如果单选按钮（对象）的位置=“AF22”，则链接单元格=新范围的第一列+右侧的11列（例如T列+11列=列“AD”）因此新单元格引用=“AD22” 编辑: 我删除了我的部分代码，这似乎是多余的。下面的代码完美地复制和粘贴数据和对象。但是我在 Linkedcell 部分需要帮助 

`Sub Macro2()
Dim rng, rng1, rng2 As Range, s As Shape, ws As Worksheet, sr As 
ShapeRange, Loc As String
Set ws = ActiveWorkbook.ActiveSheet
Set rng = ActiveSheet.Range("E19")
Set rng1 = ActiveSheet.Range("T19:AF34")
Set rng2 = ActiveSheet.Range("E19:Q34")

'Copy the range with text and paste it to the desired location

ActiveSheet.Range("E19:Q34").copy

With rng
rng.Offset(0, 15).Select
ws.Paste
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

End With

'Trying to find option buttons and give them a new cell reference.(linked cell)
 With ActiveSheet
    'Selection = Range("V19:AC34")
    For Each s In .Shapes
        'if s.TopLeftCell.Column =
         '   .Range ("V19:AC34")

    If s.Name Like "OptionButton*" Then

     s.DrawingObject.LinkedCell = "=" & Chr(s.TopLeftCell.Column) & CStr(s.TopLeftCell.Row)
     Debug.Print s.DrawingObject.LinkedCell

        'Loc = "AD" & s.TopLeftCell.Row
        'Debug.Print Loc
        '.Value = xlOff
        'Selection.LinkedCell = Range(Loc).Address
        '.Display3DShading = False
        End If
 'End With
    Next s
 End With



End Sub`

标签： excelvbaobjectradio-button

解决方案

尝试下一个代码来选择/复制范围选择的形状：

Dim ws As Worksheet, s As Shape, rng As Range, optB As OLEObject
    Set ws = ActiveSheet
    Set rng = sh.Range("your range containing the Option Button to be copied")
    With ws 
      For Each s In .Shapes
        If Not Intersect(Range(s.TopLeftCell.Address), Range(rng.Address)) Is Nothing Then
            If s.Name = "OptionButton1" Then 'use here your option button name
                s.Copy
                Exit For
            End If
        End If
      Next s
    End With
    rng.Cells(1, 1).Offset(0, 15).Select
    ws.Paste
    'Generic way of identifying the newly pasted Option button and allocate a `LinkedCell` to it:
    'Set optB = ws.Shapes(ws.Shapes.Count).OLEFormat.Object
    'optB.LinkedCell = "=" & rng.Cells(1, 1).Offset(0, 15).Address
    Selection.LinkedCell = rng.Cells(1, 1).Offset(0, 15).Address

为了做到这一点，必须使用一个技巧，但是使用ActiveSheet.Shapes... 使用 ofrng.Cells.Offset(0, 15).Select是不明智的。这将选择范围内的许多单元格。我选择粘贴它引用范围的第一个单元格。rng.Cells()如果您想要/需要不同的位置，我认为调整代码（）会很容易。

编辑：我修改了代码以仅选择和复制一个名为“OptionButton1”的形状。请注意在这里使用您的真实形状名称！

我还展示了一种将 a 分配LinkedCell给新创建的选项按钮的方法。我必须承认，查看您的代码，我不明白您试图链接哪个单元格。我使用了一个通用的，与移动形状相同。请根据您的需要在此处使用适当的地址。

推荐阅读