ここから本文です

【不定期】オブジェクト変数またはWithブロック変数が設定されていません Acces...

アバター

ID非公開さん

2018/12/1017:44:06

【不定期】オブジェクト変数またはWithブロック変数が設定されていません

AccessVBAでExcelを開き、下記のような処理を実行しています。

1回目は問題なく実行できるのですが、二回目は
「オブジェクト変数またはWithブロック変数が設定されていません」と表示されて実行できません。

不定期にこのエラーが出る症状について調べたのですが、それらしい原因が特定できませんでした。
ご教示お願いいたします。

Public Function ShapingDATA2()

Dim xlApp As Object
Dim xlWb As Excel.Workbook
Dim xlWs As Excel.Worksheet

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
xlApp.UserControl = True
xlApp.DisplayAlerts = True

Set xlWb = xlApp.Workbooks.Open("ファイルアドレス")
Set xlWs = xlWb.Worksheets("シート名")



'最終行の取得
Dim number As Integer
Dim i As Integer
Dim test As String
i = 1
While (xlWs.Cells(i, 1) <> "")
number = i
i = i + 1
Wend
number = number - 1

'整形
'不要行・列の削除
xlWs.Rows("1:1").Select
Selection.Delete Shift:=xlUp
xlWs.Columns("B:D").Select
Selection.Delete Shift:=xlToLeft
'時間(h,m,s)フィールドの作成
xlWs.Range("F2").Select
ActiveCell.FormulaR1C1 = "=TEXT(RC[-3],""hh:mm:ss"")"
xlWs.Range("G2").Select
ActiveCell.FormulaR1C1 = _
"=iferror(IF(VALUE(LEFT(RC[-1],2))<6,TEXT(VALUE(LEFT(RC[-1],2)+24),""00""),TEXT(VALUE(LEFT(RC[-1],2)),""00"")),""--"")"
xlWs.Range("H2").Select
ActiveCell.FormulaR1C1 = "=MID(RC[-2],4,2)"
xlWs.Range("I2").Select
ActiveCell.FormulaR1C1 = "=RIGHT(RC[-3],2)"
'オートフィル
xlWs.Range("F2:I2").Select
Selection.AutoFill Destination:=Range(Cells(2, 6), Cells(number, 9))
'値で貼り付けして不要行の削除
xlWs.Columns("G:I").Select
Selection.copy
xlWs.Range("J1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
xlWs.Columns("F:I").Select
Selection.Delete Shift:=xlToLeft
xlWs.Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
'フィールド名の書き込み
xlWs.Range("E1").Select
ActiveCell.FormulaR1C1 = "hour"
xlWs.Range("F1").Select
ActiveCell.FormulaR1C1 = "minute"
xlWs.Range("G1").Select
ActiveCell.FormulaR1C1 = "second"
xlWs.Range("A1").Select
ActiveCell.FormulaR1C1 = "VIN"

'エラー行を置換
i = 2
While (xlWs.Cells(i, 1) <> "")
If xlWs.Cells(i, 2) = "----/--/--" Then
xlWs.Cells(i, 2) = "9999/09/09"
xlWs.Cells(i, 3) = "*"
xlWs.Cells(i, 5) = "*"
xlWs.Cells(i, 6) = "*"
xlWs.Cells(i, 7) = "*"
End If
i = i + 1
Wend


'保存する
xlWb.SaveAs FileName:= _
"保存先アドレス" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

'終了する
xlWb.Close (False)
xlApp.Quit



Set xlApp = Nothing
Set xlWb = Nothing
Set xlWs = Nothing

End Function

この質問は、活躍中のチエリアン・専門家に回答をリクエストしました。

閲覧数:
108
回答数:
4
お礼:
500枚

違反報告

ベストアンサーに選ばれた回答

プロフィール画像

カテゴリマスター

hot********さん

2018/12/1104:12:56

全ての「Selection」と「ActiveCell」の前に「xlApp.」を付けてみてください。

>Selection.Delete Shift:=xlUp

xlApp.Selection.Delete Shift:=xlUp


>ActiveCell.FormulaR1C1 ="=○○"

xlApp.ActiveCell.FormulaR1C1 ="=○○"

アバター

質問した人からのコメント

2018/12/12 13:43:21

解決しました。
一番ピンポイントに回答してくださったのでBAします。
みなさんありがとうございました。

ベストアンサー以外の回答

1〜3件/3件中

並び替え:回答日時の
新しい順
|古い順

プロフィール画像

カテゴリマスター

tra********さん

リクエストマッチ

2018/12/1109:17:16

マクロ記録のプログラムを手順通りに整理すればおのずと不具合はなくなるのでは?

Public Function ShapingDATA2()
Dim xlApp As Object
Dim i As Integer
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
xlApp.UserControl = True
xlApp.DisplayAlerts = True

With xlApp.Workbooks.Open("ファイルアドレス")
With .Worksheets("シート名")
'整形
'不要行・列の削除
.Rows(1).Delete Shift:=xlUp
.Columns("B:D").Delete Shift:=xlToLeft
'時間(h,m,s)フィールドの作成
.Range("F2").FormulaR1C1 = "=TEXT(RC[-3],""hh:mm:ss"")"
.Range("G2").FormulaR1C1 = _
"=iferror(IF(VALUE(LEFT(RC[-1],2))<6,TEXT(VALUE(LEFT(RC[-1],2)+24),""00""),TEXT(VALUE(LEFT(RC[-1],2)),""00"")),""--"")"
.Range("H2").FormulaR1C1 = "=MID(RC[-2],4,2)"
.Range("I2").FormulaR1C1 = "=RIGHT(RC[-3],2)"
'最終行までオートフィル
.Range("F2:I2").AutoFill Destination:=.Range("F2:I" & .Cells(Rows.Count, 1).End(xlUp).Row)
'値で貼り付けして不要行の削除
.Columns("G:I").Copy
.Range("J1").PasteSpecial Paste:=xlPasteValues
.Columns("F:I").Delete Shift:=xlToLeft
.Columns("C:C").Delete Shift:=xlToLeft
'フィールド名の書き込み
.Range("E1").Value = "hour"
.Range("F1").Value = "minute"
.Range("G1").Value = "second"
.Range("A1").Value = "VIN"
'エラー行を置換
i = 2
While (.Cells(i, 1) <> "")
If .Cells(i, 2) = "----/--/--" Then
.Cells(i, 2) = "9999/09/09"
.Cells(i, 3) = "*"
.Cells(i, 5) = "*"
.Cells(i, 6) = "*"
.Cells(i, 7) = "*"
End If
i = i + 1
Wend
End With
'保存する
.SaveAs Filename:="保存先アドレス", FileFormat:=xlOpenXMLWorkbookMacroEnabled
'終了する
.Close False
End With
xlApp.Quit
Set xlApp = Nothing
End Function

kik********さん

2018/12/1021:26:50

以下、私が感じたことなので、嘘が多いかも・・・
でも、そうかな・・・とかなら、さらに調べてみるとか・・・

> AccessVBAでExcelを開き・・・・

Access さんで、Excel を参照設定した際、
動き初めには、Excel の裏方さんが ひとり 居るみたい

Excel のオブジェクトを作って、記述していく過程で、
作ったオブジェクトの修飾がない・・・けど、Excel の使い方かも・・・
この時に、Excel の裏方さんは、
生成された Excel のオブジェクトになり変って、処理を続けようとする?
そうするうちに、生成した Excel オブジェクトと裏方さんは一体になって・・・
最後に、Nothing したことで、裏方さんも消える・・・??

なので、2度目は裏方さんは居なくなったので・・・・
そんな記述わからない・・・・で、エラーに

記述を見ていくと、

> Selection.Delete Shift:=xlUp

この Selection って、誰が解釈するもの?

> ActiveCell.FormulaR1C1 = ・・・・

ActiveCell って何?

> Range(Cells(2, 6), Cells(number, 9))

中の Cells(2, 6) ・・・って何?


1回でも動けば儲けもの・・・???

実際に正しい記述しているのかは、
・参照設定をはずして
・Excel での定数は Const で定義するようにして

それで実行してみるとか・・・

開発時は、参照設定組み込みでも良いかもしれない
運用に向けて・・・なら、
参照設定をはずしたものが良いかも??

参照設定していると、上位バージョンで動かした際、
参照設定が書き変わり、
以後、下位バージョンで実行しようとしたら、
参照設定が不正で動かなくなったり・・・・したような気がする


まずは、修飾を正しく記述したものに書き換えて・・・みる???

typ********さん

2018/12/1018:59:30

'オートフィル
xlWs.Range("F2:I2").Select
Selection.AutoFill Destination:=Range(Cells(2, 6), Cells(number, 9))



'オートフィル
xlWs.Range("F2:I2").AutoFill Destination:=xlWs.Range(xlWs.Cells(2, 6), xlWs.Cells(number, 9))

に書き直しても一緒ですかね?
Range、Cellに対して、どのシートのという記述が漏れているのが
誤動作の原因になっているのかと思いました。

あわせて知りたい

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる