Range.copy 来自另一个应用程序的 运行 excel 宏时的问题
Range.copy problem when running excel macro from another application
我正在尝试 运行 从另一个 application.The 代码 运行 中 excel 中的这段代码没有问题,但是 rngNumber.Copy wsData.Range("A2")
没有被复制.我在 excel 中直接测试了相同的代码,它被完美地复制了。我认为当代码从另一个应用程序 运行ned 时,可能 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
明确定义 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
我正在尝试 运行 从另一个 application.The 代码 运行 中 excel 中的这段代码没有问题,但是 rngNumber.Copy wsData.Range("A2")
没有被复制.我在 excel 中直接测试了相同的代码,它被完美地复制了。我认为当代码从另一个应用程序 运行ned 时,可能 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
明确定义 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