Microsoft Access ClubAccess超初心者対象ForumAccess初級者対象ForumAccess初・中級者対象ForumAccess VBA Tips ForumDAO、ADO、SQL Forum

     

No15408.ACCESS上からEXCEL VBAの制御

タイトルACCESS上からEXCEL VBAの制御
記事No: 15408
投稿日: 2004/08/24(Tue) 13:15
投稿者: けんすけ
OS:XP
Access Version:2003

いつもお世話になっております。
けんすけです。
よろしくお願いいたします。

ボタンクリック後に、下記のVBコードでEXCELファイルへの出力を行っております。
出力のみの動作は問題ないのですが、
EXCELを開き、罫線絵画とAutofitでセルサイズの変更を行うところでエラーが出てしまい困っています。
エラーの内容は「実行時エラー1004:'Cells'メソッドは失敗しました _'Global'オブジェクト」です。

CODE:

'***** 良品データの有無チェック *****'
If DCount("*", "良品出荷リスト") > 0 Then
OutName = ""
OutName = "RMA-" & Me.ODM選択 & "[OK](" & Me.年 & "-" & Me.月 & "-" & Me.日 & ")" & DCount("*", "良品出荷リスト") & "p"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "良品出荷リスト", SetPass & "\" & OutName, True
'EXCELファイルの書式設定
Set apEXL = CreateObject("Excel.Application")
apEXL.Workbooks.Open FileName:=SetPass & "\" & OutName
Call 書式設定
apEXL.Workbooks.Close
End If
'***** 不良品データの有無チェック *****'
If DCount("*", "不良品出荷リスト") > 0 Then
OutName2 = ""
OutName2 = "RMA-" & Me.ODM選択 & "[NG+List](" & Me.年 & "-" & Me.月 & "-" & Me.日 & ")" & DCount("*", "不良品出荷リスト") & "p"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "不良品出荷リスト", SetPass & "\" & OutName2, True
'EXCELファイルの書式設定
Set apEXL = CreateObject("Excel.Application")
apEXL.Workbooks.Open FileName:=SetPass & "\" & OutName2
Call 書式設定
apEXL.Workbooks.Close
End If

上記の
「Call 書式設定」←が二回目に呼び出されるとエラーが発生してしまいます。

書式設定のCODEは下記です。
Private Sub 書式設定()
Cells.Select '←”ここが発生ポイントです”
Cells.EntireColumn.AutoFit

Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("A1").Select
ActiveWorkbook.Save
End Sub

「良品出荷リスト」の出力のみの場合、「不良品出荷リスト」の出力のみの場合では
問題なくEXCEL出力・書式設定が行われています。
環境設定の Microsoft EXCEL 11.0 ObjectLiblary へのチェックはされています。
よろしくお願いします。

タイトルRe: ACCESS上からEXCEL VBAの制御
記事No: 15409
投稿日: 2004/08/24(Tue) 13:48
投稿者: けんすけ
> 'EXCELファイルの書式設定
> Set apEXL = CreateObject("Excel.Application")
> apEXL.Workbooks.Open FileName:=SetPass & "\" & OutName
> Call 書式設定
> apEXL.Workbooks.Close
> End If
開いたEXCELがアクティブなままだと思い、
「Call 書式設定」以下を下記のように全て変えて見ましたが、同一エラーです・・・

apEXL.ActiveWorkbook.Close SaveChanges:=True
apEXL.Quit
Set apEXL = Nothing

タイトルRe: ACCESS上からEXCEL VBAの制御
記事No: 15411
投稿日: 2004/08/24(Tue) 16:56
投稿者: サンデー

> DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "良品出荷リスト", SetPass & "\" & OutName, True
> 'EXCELファイルの書式設定
> Set apEXL = CreateObject("Excel.Application")
> apEXL.Workbooks.Open FileName:=SetPass & "\" & OutName

Dim objBook As Excel.Workbook
Dim objWs As Excel.Worksheet と宣言して、下記二行を追加
Set objBook = appXL.Workbooks.Open("SetPass & "\" & OutName2 & ".xls", True)
Set objWs = objBook.Worksheets("良品出荷リスト")
中略
objBook.Close SaveChanges:=True
Set objWs = Nothing
Set objBook = Nothing
apEXL.Quit: Set apEXL = Nothing

> Private Sub 書式設定()
> Cells.Select '←”ここが発生ポイントです”
> Cells.EntireColumn.AutoFit
いきなりセルを参照せずに、objWs.cells.selec・・・
> Range("A1").Select
ここも同様、上流から指定しないと、新たなインスタンスが発生します。

> Range(apEXL.Selection, apEXL.Selection.End(xlToRight)).Selectだったかな?
selection に関する部分は自信がありません。

'***** 良品データの有無チェック *****'
だけを走らせて後、タスクマネージャのプロセスにエクセルが無ければOKです

タイトルRe^2: ACCESS上からEXCEL VBAの制御
記事No: 15413
投稿日: 2004/08/24(Tue) 18:43
投稿者: けんすけ
宣言名に関連性が無いと、後で見るのに良く分からなくなってしまうと思い、
宣言名の統一をしました。

<宣言>
Dim xlsApp As Excel.Application
Dim xlsWbk As Excel.Workbook
Dim xlsWst As Excel.Worksheet

<EXCEL読込み・終了部分>
Set xlsApp = CreateObject("Excel.Application")
Set xlsWbk = xlsApp.Workbooks.Open(SetPass & "\" & OutName & ".xls", True)
xlsApp.Visible = True
Call 書式設定("良品出荷リスト", xlsWbk, xlsApp)
xlsWbk.Close SaveChanges:=True
Set xlsWst = Nothing
Set xlsWbk = Nothing
xlsApp.Quit: Set xlsApp = Nothing


<ワークシート書式設定部分>
Private Sub 書式設定(Qname As String, xlsWbk As Excel.Workbook, xlsApp As Excel.Application)
Dim xlsWst As Excel.Worksheet
Set xlsWst = xlsWbk.Worksheets(Qname)
xlsWst.Cells.Select
xlsWst.Cells.EntireColumn.AutoFit
xlsWst.Range("A1").Select
xlsWst.Range(xlsApp.Selection, xlsApp.Selection.End(xlToRight)).Select
xlsWst.Range(xlsApp.Selection, xlsApp.Selection.End(xlDown)).Select
xlsApp.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
xlsApp.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With xlsApp.Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With xlsApp.Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With xlsApp.Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With xlsApp.Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With xlsApp.Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With xlsApp.Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
xlsWst.Range("A1").Select
End Sub

上記に変更したところ、正常に動作が行えました。
サンデーさんありがとうございました。


このAccessフォーラム過去ログ集は、Microsoft Access Club が運営しています

年額2,400円でドメインネームサーバーをご用意します。自宅サーバ構築時にご利用下さい。自宅サーバーは応用範囲が広いです。
年額2,400円でドメインネームサーバー。
自社・自宅サーバ構築時にご利用下さい。
やはり、自前サーバーは応用範囲が広いです。

 

ページの先頭へ 前ページへ戻る