vba excel:如何使用图像复制工作表但没有按钮

时间:2016-09-22 10:46:16

标签: excel vba excel-vba

我有一张带有图像和2个按钮的工作表。 (发票) 我想将带有图像但没有2个按钮的工作表复制到新工作簿的新工作表中,我想用vba宏来完成它。 在我使用通常的复制命令执行它的那一刻,并为2个按钮使用额外的删除命令。

我相信有一种更简单的方法可以做到这一点。 我试过这个......

Application.CopyObjectsWithCells = False
Sheets("invoice").Select
Sheets("invoice").Move After:=Workbooks("invoices").Sheets(1)
Application.CopyObjectsWithCells = True

这些按钮失去了按钮,但图像也消失了。但我想保留图像。

我希望你们可以帮助我。

提前感谢。

1 个答案:

答案 0 :(得分:0)

解释见以下代码中的注释:

Option Explicit

Sub CopySheet_WO_Btn()

Dim newWB                       As Workbook
Dim ShtOrig                     As Worksheet

Dim Obj                         As OLEObject
Dim PicShape                    As Shape
Dim PicLeft                     As Double
Dim PicTop                      As Double

Set ShtOrig = ThisWorkbook.Sheets("invoice")

' loop through all objects in "invoice" sheet
For Each Obj In ShtOrig.OLEObjects

    ' if OLE Object is type CommanButton make it Un-Visible (not to copy with the sheet)
    If Obj.progID = "Forms.CommandButton.1" Then
        Obj.Visible = False
    End If

Next Obj

Set newWB = Workbooks.Add(xlWBATWorksheet)
ShtOrig.Copy newWB.Sheets(1)

' loop through all shapes in "invoice" sheet and copy the pictures
For Each PicShape In ShtOrig.Shapes
    If PicShape.Name = "Picture 1" Then
        PicLeft = PicShape.Left
        PicTop = PicShape.Top
        PicShape.Copy

        newWB.Sheets(1).Paste
        Selection.ShapeRange.Left = PicLeft
        Selection.ShapeRange.Top = PicTop
    End If
Next PicShape

' loop again and return the CommandButtons to be Visible in "invoice" sheet
For Each Obj In ShtOrig.OLEObjects
    Obj.Visible = True
Next Obj

End Sub