BarCode.Office 5.0.0 を利用して物流用PDラベルを作成してます。
バーコードはGS1-128で作成件数は３００件程度です。
VBAでループさせて入力データを読んでBARCODE、およびラベルデータ
EXCELに編集していきますが、実行途中で
実行時エラー '1004'
WorkSheetクラスのPasteメソッドが失敗しました
のメッセージで異常終了する事が頻発しています。
異常が発生する箇所は実行する都度違います。
処理中にインターバルをいれると多少は改善されていますが、
300件程度の入力に対して問題なく完走できるのは１０回に１回程度です
また、バーコードイメージが出力したいページから１ページずれて表示される事があります。
本プログラムは2022年ころ作成したものでその時から問題なく動いていましたが
本年４月ころHDD→SSDに変更したところ急に上記の様な異常が発生する様になりました。
お忙しいところ申し訳ありませんが、この様な事例がございませんでしょうか。
これまでにそのような事例はございませんが、
ActiveXコントロールの貼り付けではなく、VBAのプログラムで新規にバーコードを作成しまくる。という方式と理解してよろしいでしょうか？
クリップボードを使用しているため、想定できる動作ではあります。
SSDで処理が速くなったこと、加えて、
処理中にインターバルを入れると少し改善されるということですので、
毎回のディレイを長めにとるしかないと思います。
このようなお答えで申し訳ないのですが、根本的に作成しなおすとなるとクリップボード転送を別の方式に変える必要があり、すぐに対応することは困難です。
まずは、ディレイを長めにとってお試しいただけますか？
メールも頂戴していたと思います。返事ができておらず申し訳ございません。
運用でお使いのExcelをスリム化しても再現する単純なサンプルを作成していただき、
メールでお送りいただければ、解決策を模索させていただきます。
よろしくお願いいたします。
ps.
もう1つ同じ下記子もhがございましたので、そちらは削除させていただきます。
インターバルについては設定箇所、時間ともにいろいろなパターンをためしましたが、解決にはいたりませんでした。
＞クリップボード転送を別の方式に変える必要があり、すぐに対応することは困難です。
クリップボード転送以外の方式については教えていただくことは可能でしょうか。
>運用でお使いのExcelをスリム化しても再現する単純なサンプルを作成していただき、
メールでお送りいただければ、解決策を模索させていただきます。
サンプルをメールしたら検証していただけるという事でしょうか。
クリップボードを利用してバーコード画像の転送を行っているのは、Barcode.Office の実装方式そのものになりますので、
弊社開発側で大幅な方式変更を行わない限り、変更はできません。また、変更したとしても現在のタイミングの問題を可決できるかどうか？現状では目途は立てておりません。
単純な、サンプルをお送りいただければ、少なくとこちらでも同じ動作を確認させていただき、現象を共有させていただきます。
その後、改善方法がないか？について、取り掛かるところまではお約束します。
※マシン環境の違いにより、現象が再現できない可能性もご承知おきください。
よろしくお願いいたします。
info@pao.ac に動作可能なサンプルをおくりました。
共有いただけるとたすかります。
よろしくお願いします。
本来、Paste の前でバーコードを書いた後の方がいいと思ますが、
Pasete の後に、次のようにインデントの無いロジックを加えたら、お客様のプログラムで最後までバーコードを描画しました。
ActiveSheet.Paste
' バーコード描画後の確実な待機
For k = 1 To 10 ' 最大1秒待機
DoEvents
Sleep 100
If Not Application.CutCopyMode Then Exit For
Next k
' Paste前の待機も追加
Sleep 500 ' より長めの待機
DoEvents
ActiveSheet.Shapes(i + 1).Select
「Sleep」は、次のように、宣言しておいてください。
#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
ーーーー
これで十分問題ないと思いますが、
万一Pasteでエラーになるような事象が発生するときは、
次のようなクリップボード監視を行う関数を追加します。
#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
#End If
Private Const CF_BITMAP As Long = 2
Private Const CF_DIB As Long = 8
Private Const CF_ENHMETAFILE As Long = 14
Private Function WaitClipboardImage(ByVal timeoutMs As Long) As Boolean
' 画像系がクリップボードに載るまで待つ
Dim t As Single: t = Timer
Do
If IsClipboardFormatAvailable(CF_BITMAP) <> 0 _
Or IsClipboardFormatAvailable(CF_DIB) <> 0 _
Or IsClipboardFormatAvailable(CF_ENHMETAFILE) <> 0 Then
WaitClipboardImage = True
Exit Function
End If
DoEvents
Sleep 15
If (Timer - t) * 1000! >= timeoutMs Then Exit Do
Loop
End Function
Private Function SafePasteShape(ws As Worksheet, tgt As Range, _
Optional pasteTimeoutMs As Long = 1000, _
Optional retries As Long = 3) As Shape
Dim k As Long, before As Long, t As Single
ws.Activate
tgt.Select
For k = 1 To retries
before = ws.Shapes.Count
ActiveSheet.Paste
t = Timer
Do
DoEvents
If ws.Shapes.Count > before Then
Set SafePasteShape = ws.Shapes(ws.Shapes.Count)
Exit Function
End If
Sleep 15
If (Timer - t) * 1000! >= pasteTimeoutMs Then Exit Do
Loop
' 貼付け失敗 → もう少し待って再試行
Sleep 120
Next k
Set SafePasteShape = Nothing
End Function
--- あなたのプログラム ---
'--- クリップボードに画像が載るまで最大2秒待つ ---
If Not WaitClipboardImage(2000) Then
Err.Raise vbObjectError + 513, , "バーコード画像がクリップボードに来ませんでした。"
End If
'--- セルを選択して「増えた Shape を確認しながら貼り付け」 ---
Dim shp As Shape
Set shp = SafePasteShape(wbt.Sheets("sheet1"), wbt.Sheets("sheet1").Cells(iform_start + 1, 2), 1500, 4)
If shp Is Nothing Then
Err.Raise vbObjectError + 514, , "貼り付けに失敗しました（タイムアウト/リトライ上限）。"
End If
Sleep 100 ' 最後に少しだけ待つ（環境差吸収）
DoEvents
shp.Rotation = 270 ' 270度回転
----
他の書き方では次のようにしてください。分かりやすいほうで・・・
' バーコード描画セル選択前に追加
Private Function WaitForClipboard(maxWaitMs As Long) As Boolean
Dim startTime As Double
startTime = Timer
Do While Timer - startTime < maxWaitMs / 1000
DoEvents
Sleep 50
' クリップボードにデータがあるかチェック
On Error GoTo ClipboardNotReady
If Application.CutCopyMode <> False Then
WaitForClipboard = True
Exit Function
End If
ClipboardNotReady:
On Error GoTo 0
Loop
WaitForClipboard = False
End Function
ーーー
他にも方法はございます。もし他のお客様でも大量のバーコードをExcelマクロで同的に生成するケースで、うまくいかない時は、参考にされて、
それでもうまくいかないときはお問い合わせください。
よろしくお願いいたします。
前半の対応をおこない大量（３００件程度）でも問題なく動作することを確認しました。
この対応にて様子をみたいとおもいます。
ありがとうございました。
- YY-BOARD -