| |
▼K.S さん、かみちゃん さん
こんにちは。
既に解決されていて、ご覧になる機会があるかは解りませんが…。
> appExcel.Worksheets(varsheet).Select
>ActiveSheet.Range(Cells(1, 1), Cells(最下行番号, 右端列番号)).Copy
Activate や Select は潜在的なバグの元となるので
極力使用を避けたほうが安定したコードになるかと思われます。
また xlup の様な定数が使われているので
Excelが参照設定されていると思われます。
変数宣言もobject型でなく、Excelのオブジェクトを指定できそうですね。
また二つのBookを直接開くので、クリップボードにコピーしなくてもできそうです。
Private Sub コマンド0_Click()
On Error GoTo エラー
Const varinput1 = "C:\サンプルbook.xls"
Const varinput2 = "D:\tempサンプルbook.xls"
Const varsheet = "サンプル"
Dim xlsApp As Excel.Application
Dim xlsWkb(1 To 2) As Excel.Workbook
Dim xlsSht(1 To 2) As Excel.Worksheet
Dim 最下行番号 As Long
Dim 右端列番号 As Integer
Call file_check(varinput2)
Set xlsApp = CreateObject("Excel.Application")
'xlsApp.Visible = True
Set xlsWkb(1) = xlsApp.Workbooks.Open(varinput1)
Set xlsWkb(2) = xlsApp.Workbooks.Add
Set xlsSht(1) = xlsWkb(1).Sheets(varsheet)
Set xlsSht(2) = xlsWkb(2).Sheets(1)
最下行番号 = xlsSht(1).Cells(xlsSht(1).Rows.Count, 1).End(xlUp).Row
右端列番号 = xlsSht(1).Cells(1, xlsSht(1).Columns.Count).End(xlToLeft).Column
xlsSht(2).Range(xlsSht(2).Cells(1, 1), xlsSht(2).Cells(最下行番号, 右端列番号)).Value = _
xlsSht(1).Range(xlsSht(1).Cells(1, 1), xlsSht(1).Cells(最下行番号, 右端列番号)).Value
xlsWkb(2).SaveAs varinput2
xlsWkb(2).Close
xlsWkb(1).Close False
xlsApp.Quit
Set xlsSht(2) = Nothing
Set xlsSht(1) = Nothing
Set xlsWkb(2) = Nothing
Set xlsWkb(1) = Nothing
Set xlsApp = Nothing
Exit Sub
エラー:
If Err.Number = 1004 Then
Resume Next
Else
MsgBox Err.Number & " : " & Err.Description
End If
End Sub
Private Sub file_check(inFile As String)
On Error Resume Next
Kill inFile
On Error GoTo 0
End Sub
ファイルのチェックの所は K.S さん の方が丁寧で良いと思われるのですが
一応こんなやり方もあるという事で紹介させて頂きます。
|
|
![[未読]](./data/access/image/read_icon.gif){kind=icon}
- 07/1/22(月) 22:32 -
