首页 文章

Excel vba Shape Paste不起作用

提问于
浏览 次
1

我试图将文本框从sheet1粘贴到sheet2

Function footer()
Application.Volatile True
r = Application.Caller.Address
SheetName = Application.Caller.Parent.Name

    Select Case Range("Locale").Value
        Case "RU": boxx = Range("company").Value & Range("Locale")
        Case "EN": boxx = Range("company").Value & Range("Locale")
    End Select
Worksheets("Translations").Shapes(boxx).Copy
MsgBox Worksheets("Translations").Shapes(boxx).TextFrame.Characters.Text
ActiveSheet.Paste
End Function

Msgbox看起来没问题，但粘贴功能什么都不做，我尝试了不同的方法

  • ActiveSheet.range（"A1"）.Paste

  • ActiveSheet.range（"A1"）.PasteSpecial

  • 工作表（SheetName）.Paste

  • 工作表（SheetName）.Range（r）.Paste

一切都不起作用，表中没有任何内容，什么是错的？

excel vba excel-vba

2 回答

  • 1

    虽然您无法复制和粘贴形状，但可以添加新形状并从原始文本复制文本和格式 - 例如：

    Function footer()
    Dim boxx                  As String
    Dim shpTo                 As Shape
    Dim shpFrom               As Shape

    Application.Volatile True

    Select Case Range("Locale").Value
        Case "RU": boxx = Range("company").Value & Range("Locale")
        Case "EN": boxx = Range("company").Value & Range("Locale")
    End Select
    Set shpFrom = Worksheets("Translations").Shapes(boxx)
    With Application.Caller
        Set shpTo = .Worksheet.Shapes.AddShape(shpFrom.AutoShapeType, .Left, .Top, shpFrom.Width, shpFrom.Height)
        shpTo.TextFrame.Characters.Text = shpFrom.TextFrame.Characters.Text
    End With
    shpFrom.PickUp
    shpTo.Apply
End Function
    回复于
  • 1

    试试这个复制方法

    ThisWorkbook.Sheets("Sheet1").Shapes.Range(Array(shpFrom.Name)).Select
Selection.Copy
    回复于

相关问题