從另一個應用程式運行excel宏時的Range.copy問題

我正在嘗試從另一個應用程式在 excel 中運行此代碼。代碼運行沒有問題，但rngNumber.Copy wsData.Range("A2")沒有被復制。我已經直接在excel中測驗了相同的代碼，它被完美地復制了。我認為rngNumber當代碼從另一個應用程式運行時可能沒有正確設定。但是，我不明白確切的原因。任何建議將不勝感激，謝謝。

Sub TEST()

' Try to connect to a running instance of Excel.
    Dim excelApp As Excel.Application
    On Error Resume Next
    Set excelApp = GetObject(, "Excel.Application")
    
    If Err Then
        Err.Clear
        
        ' Couldn't connect so start Excel.  It's started invisibly.
        Set excelApp = CreateObject("Excel.Application")
        
        If Err Then
            MsgBox "Cannot access excel."
            Exit Sub
        End If
    End If
    
    ' You can make it visible if you want.  This is especially
    ' helpful when debugging.
    excelApp.Visible = True

    'Open the excel file (through dialog)
    Dim ExcelFilePath As Variant
    ExcelFilePath = excelApp.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*")
    If ExcelFilePath <> False Then
        Set wb = excelApp.Workbooks.Open(ExcelFilePath)
    End If
    
    ' Open the excel file
    Dim wb as Workbook
    Set wb = excelApp.ActiveWorkbook
    Dim ws as Worksheet
    Set ws = wb.Worksheets(1)
    ws.Activate
   
    'Set Worksheet
    Dim wsData As WorkSheet
    Set wsData = wb.Worksheets(2)
    
    'Write column titles
    With wsData
        .Cells(1, "A").Value = "Number"
    End With
           
    'Get column letter for each column whose first row starts with an specific string
     ws.Activate
     Dim sNumber as String
     sNumber= Find_Column("Number") 
        
    'Define variables
    Dim rngNumber As Range
                 
    ' Copy and paste data from "Number" column to Column "A" in Worksheets "Data"
    ws.Activate
    'Find which is the last row with data in "Number" column and set range
    With ws.Columns(sNumber)
        Set rngNumber = Range(.Cells(2), .Cells(.Rows.Count).End(xlUp))
    End With
    'Copy and paste data from "Number" column
    rngNumber.Copy wsData.Range("A2")

End Sub

Private Function Find_Column(Name As String) As String
   
    Dim rngName As Range
    Dim Column As String
    
    With ws.Rows(1)
        On Error Resume Next
        Set rngName = .Find(Name, .Cells(.Cells.Count), xlValues, xlWhole)
        ' Calculate Name Column Letter.
        Find_Column = Split(rngName.Address, "$")(1)
                
    End With
    
End Function

uj5u.com熱心網友回復：

顯式定義excel物件并洗掉On Error Resume Next。這適用于 Word。

Option Explicit

Sub TEST()

    ' Try to connect to a running instance of Excel.
    Dim excelApp As Excel.Application
    Dim wb As Excel.Workbook
    Dim ws As Excel.WorkSheet, wsData As Excel.WorkSheet
    Dim rngNumber As Excel.Range
    
    On Error Resume Next
    Set excelApp = GetObject(, "Excel.Application")
    If Err Then
        Err.Clear
            
        ' Couldn't connect so start Excel.  It's started invisibly.
        Set excelApp = CreateObject("Excel.Application")
            
        If Err Then
            MsgBox "Cannot access excel."
            Exit Sub
        End If
    End If
    On Error GoTo 0
    
    ' You can make it visible if you want.  This is especially
    ' helpful when debugging.
    excelApp.Visible = True
    excelApp.WindowState = xlMinimized

    'Open the excel file (through dialog)
    Dim ExcelFilePath As Variant
    ExcelFilePath = excelApp.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*")
    If ExcelFilePath = False Then
         MsgBox "No file not selected"
         Exit Sub
    End If

    Set wb = excelApp.Workbooks.Open(ExcelFilePath)
    Set ws = wb.Sheets(1)
    Set wsData = wb.Sheets(2)
          
    ' Get column letter for each column whose first row
    ' starts with an specific string
    Dim sNumber As String, LastRow As Long
    sNumber = Find_Column(ws, "Number")
    If sNumber = "#N/A" Then
        MsgBox "Column 'Number' not found in " & vbLf & _
                "Wb " & wb.Name & " Sht " & ws.Name, vbExclamation
        Exit Sub
    End If
                
    ' Copy and paste data from "Number" column to Column "A" in Worksheets "Data"
    ' Find which is the last row with data in "Number" column and set range
    With ws
        LastRow = .Cells(.Rows.Count, sNumber).End(xlUp).Row
        Set rngNumber = .Cells(1, sNumber).Resize(LastRow)
    End With
    'Copy and paste data from "Number" column
    rngNumber.Copy wsData.Range("A1")

    excelApp.WindowState = xlMinimized
    MsgBox LastRow & " rows copied from column " & sNumber, vbInformation

End Sub

Private Function Find_Column(ws, Name As String) As String
   
    Dim rngName As Excel.Range
    With ws.Rows(1)
        Set rngName = .Find(Name, After:=.Cells(.Cells.Count), _
                       LookIn:=xlValues, lookat:=xlWhole)
    End With

    If rngName Is Nothing Then
        Find_Column = "#N/A"
    Else   ' Calculate Name Column Letter.
        Find_Column = Split(rngName.Address, "$")(1)
    End If
    
End Function

標籤：擅长 vba 复制

上一篇：對不同的作業表重復操作

下一篇：在Excel中查詢另一個表