エクセルに入力してあるJANコードを、バーコードに変換しよう!( excel VBA編)

2018/04/01


前回の説明記事の手順編が終了していることを前提にします。
エクセルに入力してあるJANコードを、バーコードに変換しよう!(手順編)

web上でいろいろ調べてみたけど、結構、エラーで頭悩まされました。。。
MiBarcode は、かなり便利なんだけど、クリップボード関連のエラーが多いようです。

いろいろ試した結果オーライの、僕なりの解決 VBA ってことで。

VBA の処理順としては。

0、誤って、2度、3度マクロを走らせて、バーコードがどんどん重ならないようにするための削除処理
1、複数行を処理するための最終行の取得
2、オートメーションサーバーってのを使うためのオブジェクト作成
3、MiBarcode アプリケーションの基本設定
4、空白行やJANコードじゃないものは無視しつつ、バーコードを作って貼り付ける繰り返し処理
5、作ったオブジェクト(オートメーションサーバー)の解放処理

エラーのこと、いろいろ書いてるけど、そんなのどうでもいいから、コードくれって人は、最後の部分をコピペして利用してください。
ただ、すでに、組み込んでいるコードのエラー回避をする場合は、このエラー内容の把握をしていると解決しやすいかと思います。

MiBarcode を vba で使う時のエラー回避のコツ!

■エラー1
基本設定
場所は、「 MiBar.Show (0) 」とか、「 MiBar.CodeType = 0 」

■エラー2
実行時エラー
「クリップボードアクセスが拒否されました。を開けません」
という、基本、日本語おかしくね?ってツッコミは別としても、そんなエラー。
場所は、「 MiBar.Execute 」という、おそらく、MiBarcode のアプリケーションでバーコードを生成している部分。

スポンサーリンク

----- べんりあつめ。-----

■エラー3
実行時エラー
「 データを貼り付けできません。」
場所は、「 ActiveCell.PasteSpecial 」
このエラーかなり多いっぽい。

よく出るエラー3選!ってね。(笑)




ので、上記エラーを回避したいと思います。

まずは、エラー1
「 On Error Resume Next 」で回避(かなりの暴挙だけど)しようと思ったけど、
基本設定の部分なので、今回は、この基本設定そのものを設定しません!
デフォで行きます。
MiBar.Show というのは、バーコード作成時に、アプリケーションを表示させるかどうかなので、表示されていてもかまわないかと。
MiBar.CodeType は、バーコードの種類。デフォは、JANコードみたいなので、これも設定する必要なし!と。
あといくつか設定あるけど、今回は、問題なさそうだったのでパス。無視して設定自体をしません。

次、エラー2
MiBar.Execute は、アプリケーション側で、バーコードを作る部分。(たぶんね。)
ここで、エラーが出るのは致命的だけど、止まっちゃうと困るので、エラー処理入れておきます。
エラー処理入れるので、当然、エラーが出た時は、その部分のバーコードは、エクセル側に出てきませんが、エラー3と組み合わせることで、なぜか、ここのエラーは出ないようです。ま、保険の意味で入れています。

エラー3
ActiveCell.PasteSpecial
おそらく、この部分が、みなさんお困りの部分みたい。
ただ、この付近のエラーが、クリップボードアクセスが拒否されました。とか、クリップボード周りのエラーを返してくるので、結構悩まされるんですね。
クリップボードとなると、他のアプリケーション、常駐タイプとか、いろいろ関係してくるもんだから、ほぼお手上げになりそうだもんね。
ただ、よく見てると、この組み合わせは、エクセルのJANコードの番号を、MiBarcode のアプリケーションに渡して、MiBarcode のアプリケーションで作ったバーコードを、クリップボードに渡して、エクセルで、貼り付けって感じだったから、ひょっとして、貼り付ける時に、まだ、MiBarcode 側の処理が追い付いていないんじゃね?って、素人考えで、試しに、貼り付け前に、処理待ちさせてみた!

見事、成功じゃん!ってね。
マジで、超ベンリです♪

で、出来たコードは、以下になります。

Sub barcode_create()

'アクティブシートを基準にしているので、シート指定する場合は、ActiveSheetを変更してください。

'削除処理
ActiveSheet.Select
ActiveSheet.DrawingObjects.Select
Selection.Delete

'最終行の取得
Dim maxrow
With ActiveSheet.UsedRange
maxrow = .Rows(.Rows.Count).Row
End With

'変数宣言
Dim MiBar As Mibarcd.Auto

'オートメーションサーバー機能を使うためにオブジェクトを作成
Set MiBar = New Mibarcd.Auto

'基本設定は使いたい人のみ解除して使ってください。
'On Error Resume Next
'MiBar.Show (0)
'On Error Resume Next
'MiBar.CodeType = 0
'MiBar.BarScale = 1
'MiBar.AddCodeChar = 1
'MiBar.Height = 40
'MiBar.CopyType = 1

'繰り返し処理
Dim i, ii

For i = 1 To maxrow

'空白時は無視する
If Cells(i, 1).Value = "" Then
Else
MiBar.Code = Cells(i, 1).Value
On Error Resume Next
MiBar.Execute
Application.Wait [Now() + "0:00:00.1"]
Cells(i, 1).Activate
ActiveCell.PasteSpecial
End If

Next

'オブジェクトの解放
Set MiBar = Nothing

MsgBox "処理が終わりました"

End Sub

スポンサーリンク

スマホのみ下に表示