合并Excel数据和activeXbuttons

时间:2015-06-29 08:43:40

标签: excel vba excel-vba

Excel宏有问题。我正在尝试将34个不同的Excel工作表合并到一个摘要表中。

所有工作表都包含与Macro链接的数据和 ActiveXbuttons 。就像复制粘贴一样,我想使用宏进行精确的操作。

因此,在最后的表格中,我希望前面工作表中的数据和按钮作为输出。

我尝试了以下代码来复制数据,但按钮不存在且标签的顺序不正确。

Sub MergeAllWorkBook()
    Dim ws As Worksheet
    Dim ws2 As Worksheet
    Dim lRow As Long, lCol As Long, lRow2 As Long
    Dim rng As Range
    Dim offsetVal As Long
    Application.ScreenUpdating = False
    Sheets("SYNTHESE").Cells.ClearFormats
    Sheets("SYNTHESE").Cells.ClearContents
    Sheets("SYNTHESE").Activate
    offsetVal = 1
    For Each ws In Worksheets
    If ws.Name <> "SYNTHESE" Then
    With ws
    lRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
    Debug.Print lRow
    lCol = .UsedRange.Columns(.UsedRange.Columns.Count).Column
    Debug.Print lCol
    Set rng = .Range(.Cells(1, 1), .Cells(lRow, lCol))
    With rng.Copy
      End With
    End With
    Worksheets("SYNTHESE").Cells(Rows.Count, 1).End(xlUp).Offset    
    (offsetVal,0).PasteSpecial (xlPasteAll) 'offsetVal = offsetVall 
   End If 
   Next  ws
End Sub

知道如何解决这个问题吗?

2 个答案:

答案 0 :(得分:0)

CopyPasteSpecial都不会使用普通的Excel界面复制ActiveX控件,即使您复制整个工作表也是如此。因此,在VBA中,RangeWorksheet等对象的相应方法也不会复制ActiveX控件,这一点也不足为奇。

当然,ActiveX控件可以从一个工作表复制到另一个工作表,因此建议您使用宏录制器来确定如何复制和粘贴控件 - 即发现涉及哪些工作表对象/方法/属性。一旦你发现了这些,你可能需要进一步发挥作用,以确保在将控件粘贴到另一个工作表(例如&#34; SYNTHESE&#34;)时按钮位置正确并与正确的宏相关联#39; S

宏录制器可以成为您的朋友,帮助您了解哪些对象,属性和方法与您要实现的目标相关,但您需要创造性地使用它,而不是盲目地遵循它生成的笨重代码。

答案 1 :(得分:0)

  Sub MergeAllWorkBook()
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim lRow As Long, lCol As Long, lRow2 As Long
Dim rng As Range
Dim offsetVal As Long
Application.ScreenUpdating = False
Sheets("SYNTHESE").Cells.ClearFormats
Sheets("SYNTHESE").Cells.ClearContents
Sheets("SYNTHESE").Activate
offsetVal = 1
For Each ws In Worksheets
If ws.Name <> "SYNTHESE" Then
With ws
lRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
Debug.Print lRow
lCol = .UsedRange.Columns(.UsedRange.Columns.Count).Column
Debug.Print lCol
Set rng = .Range(.Cells(1, 1), .Cells(lRow, lCol))
With rng.Copy
  End With
End With
Worksheets("SYNTHESE").Cells(Rows.Count, 1).End(xlUp).Offset    
(offsetVal,0).PasteSpecial (xlPasteAll) 'offsetVal = offsetVall 

结束如果    接下来是

End Sub

    Sub CopyImages_Controls() 
    Dim sh As Shape 
    Dim ws As Worksheet 
    Dim selRange As Range 
    For Each ws In Worksheets
    If ws.Name <> "SYNTHESE" Then 
    For Each sh In ws.Shapes 
    sh.copy 
    Sheets("SYNTHESE").Cells(sh.TopLeftCell.Row,                       
    sh.TopLeftCell.Column).Activate Worksheets("SYNTHESE").PasteSpecial 
     MsgBox sh.Name & "---" & sh.TopLeftCell.Row 
    Next sh 
    End If 
   Next ws
   End Sub