現象
レコードを読むたびに
Set MiBar = New Mibarcd.Auto
set MiiBar=nothingしていたら
アクティブXコンポーネントはオブジェクトを作成できません
というエラーが、何レコード目かで出る現象が発生。
何レコード目で出るかは不定、また、pcによってエラーが出たり出なかったりした。
このエラーが出る前兆は30秒ほど固また後、上記エラーが出る。
デバッグからvbe(エディター画面)にいってf5を押すと再開される
変更後
バーコード表示用のレコードを読む先頭でSet MiBar = New Mibarcd.Autoを入れて
読み込み終了でset MiiBar=nothingしていたら、処理も早くなってこけなくなった
変更後のサンプルコード
worksheets("納品書").Activate
mai = 0
'レコードを読む前にセット
'Mibarcodeのオートメーションサーバオブジェクトを作成
Set MiBar = New Mibarcd.Auto
x = 0
For Count1 = 0 To co - 1
'レコードを読み込んで納品書シートに書き込み+バーコード作成
GoSub meisub
Next Count1
'印刷範囲を設定する
GoSub prtara
’終了したときオブジェクト破棄
Set MiBar = Nothing
Exit Sub
meisub:
’あらかじめ前のスクリプトで、配列変数にレコード一式読み込んでます。
newdt = ndt(Count1)
newfct = fct(Count1)
newdn = dncd(Count1)
newfct = fct(Count1)
'日付と受け入れ先が変わったら次の伝票へ。日付と受け入れ先が変わるとバーコード変数も変わるようにあらかじめデータをセットしています。
If olddt <> newdt Or x = 6 Or oldfct <> newfct Or olddn <> newdn _
Or oldfct <> newfct Then
'変わったら伝票にバーコードを入れる
GoSub breaksub
End If
'伝票の明細部分の書き出し
Cells((mai - 1) * 14 + x + 5, 1) = hncd(Count1)
Cells((mai - 1) * 14 + x + 5, 2) = hnnm(Count1)
Cells((mai - 1) * 14 + x + 5, 3) = sury(Count1)
Cells((mai - 1) * 14 + x + 5, 4) = tani(Count1)
'Cells((mai - 1) * 14 + x + 5, 5) = tnka(count1)
olddt = newdt
oldfct = newfct
olddn = newdn
oldfct = newfct
x = x + 1
Return
breaksub:
'伝票のヘッダ部分の書き出し
Cells((mai) * 14 + 2, 7) = dncd(Count1)
Cells((mai) * 14 + 12, 2) = hdt(Count1)
Cells((mai) * 14 + 3, 6) = tknm1(Count1)
Cells((mai) * 14 + 4, 7) = tkcd1(Count1)
Cells((mai) * 14 + 4, 2) = ndt(Count1)
Cells((mai) * 14 + 4, 5) = fct(Count1)
' ymdh=date(year(hdt(count1),"0000"),month(hdt(count1),"00"),day(hdt(count1),"00"))
'バーコード作成
GoSub barcode1
x = 1
mai = mai + 1
Return
prtara:
Worksheets("納品書").Activate
prtendr = (mai - 1) * 14 + 14
rangestr = Range(Cells(1, 1), Cells(prtendr, 7)).Address(ReferenceStyle:=xlA1)
ActiveSheet.PageSetup.PrintArea = rangestr
Return
'------------------------------------------------------------------------
barcode1:
' 変更前はここでSet MiBar = New Mibarcd.Autoしていた
MiBar.CodeType = 2 '2:code39,12:QR2コード
'基本オプションを設定
MiBar.Show (0) 'ウィンドウを隠す
' MiBar.CodeType = 2 '2:code39,12:QR2コード
'バーコード文字列の表示(0=非表示,1=表示)
MiBar.AddCodeChar = 1
'サイズ(倍率)2倍
MiBar.BarScale = 1
'バーコードの高さ
MiBar.Height = 60
'上下マージン
MiBar.HMargin = 5
'左右マージン
MiBar.VMargin = 5
'エラーレベル
MiBar.QRErrLevel = 3
'チェックデジットあり
MiBar.CheckDigit = 0
Code = ""
'データを取得
Code = dncd(Count1)
'コードをセット
MiBar.Code = Code
'バーコードを作成
MiBar.Execute
'カーソルをセットする処理
Cells((mai) * 14 + 13, 1).Activate
'カーソル位置に貼り付け
ActiveCell.PasteSpecial
’変更前はここで Set MiBar = Nothingしていた。
Return
end01tag:
End Sub
>おまけ。シートのオブジェクトと変数をクリア、contentsをすべてクリア開いた後、別のシートの枠を貼り付ける。
Sub CLEARDATA()
Application.DisplayAlerts = False
Worksheets("納品書").Activate
endr = Cells(1, 8).End(xlDown).Row
Range(Rows(1), Rows(endr)).Select
Selection.ClearContents
'図形削除
If ActiveSheet.Shapes.Count > 0 Then
Set 対象シート = ActiveSheet 'オブジェクトへの参照を変数に代入する
対象シート.Shapes.SelectAll 'すべての図形を選択する
Selection.Delete
End If
Worksheets("雛形").Activate
endr = Cells(1, 8).End(xlDown).Row
Range(Rows(1), Rows(endr)).Copy
Worksheets("納品書").Activate
For start1 = 0 To 8
Cells(start1 * 42 + 1, 1).Activate
ActiveSheet.Paste
Next start1
Application.DisplayAlerts = True
End Sub
0 件のコメント:
コメントを投稿