人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

エクセルVBA(マクロ)でバーコードを生成する方法を教えて下さい。

エクセルでバーコードを作る ?コントロール版?
http://takashixxx.blog88.fc2.com/blog-entry-23.html
を参考に以下のマクロを作りましたが、うまくいきません。
具体的には、「コードエラー」もしくは「バーコードは生成されるが、透明で、プロパティが指定できない」となります。

ActiveSheet.OLEObjects.Add(ClassType:="BARCODE.BarCodeCtrl.1", link:=False _
, DisplayAsIcon:=False, Left:=489.705882352941, Top:=41.4705882352941, _
Width:=123.529411764706, Height:=53.8235294117647).Select

cells(r,3)の中に、
バーコードの高さ=セルの1/2、
バーコードの幅=セルの3/4、
バーコードの位置=セルの上から1/4、左から1/4
バーコードのリンク=cells(r,2)
でバーコードを次々に作成するマクロを作りたいのですが、代わりに作っていただけると助かります。エラーの原因の指摘だけでも構いません。

●質問者: ReoReo7
●カテゴリ:インターネット ウェブ制作
✍キーワード:ADD LINK SELECT TOP VBA
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● Silvanus
●70ポイント ベストアンサー

リスト中にもコメント入れていますが、一旦描画されたバーコードの高さが

本来であれば配置されているセルの高さの変更に連動して変化しなければならないのですが、

私の能力ではどうやっても解決できませんでした…。

それ以外は、恐らく期待通りの動作になっているのではないかと思います。

' 参考文書 [MSDN] MSO2003 - VBAランゲージリファレンス
' - バーコード コントロール リファレンス
' http://msdn.microsoft.com/ja-jp/library/cc391731.aspx

Option Explicit

Sub hatena_ReoReo7_101106()
 
Dim R As Long

Rows("1:3").RowHeight = 150
Columns("B:C").ColumnWidth = 40
 For R = 1 To 3
 With Cells(R, 2)
 .NumberFormatLocal = "0_ "
 .Value = 1234567890123# + R * 11111
 End With
 PasteBarCodeCtrl R, 3, R, 2
 Next

End Sub

Sub PasteBarCodeCtrl(lngCellBCY As Long, lngCellBCX As Long, lngCellValY As Long, lngCellValX As Long)
 
Const SngRelClTop As Single = 1 / 4
Const SngRelClLft As Single = 1 / 4
Const SngRelClHgt As Single = 1 / 2
Const SngRelClWdt As Single = 3 / 4
 
Const IntBCStyle As Integer = 2
 ' スタイル
 ' 0: UPC-A, 1: UPC-E, 2: JAN-13, 3: JAN-8, 4: Casecode, 5: NW-7,
 ' 6: Code-39, 7: Code-128, 8: U.S. Postnet, 9: U.S. Postal FIM, 10: 郵便カスタマーバーコード
Const IntBCSubst As Integer = 0
 ' サブスタイル (パラメータ説明省略、下記URL参照)
 ' http://msdn.microsoft.com/ja-jp/library/cc427156.aspx
Const IntBCValid As Integer = 0
 ' データの確認
 ' 0: 確認無し, 1: 無効なら修正, 2: 無効なら非表示
Const IntBCLnWgt As Integer = 3
 ' 線の太さ
 ' 0: 極細, 1:細, 2:中細, 3:標準, 4:中太, 5: 太, 6:極太, 7:超極太
Const IntBCDrctn As Integer = 0
 ' バーコードの向き
 ' 0: 0度, 1: 90度, 2: 180度, 3: 270度
Const IntBCShwDt As Integer = 1
 ' データの表示
 ' 0: 有り, 1: 無し
Const IntBCFrClr As Long = 0 ' 0 = RGB(0, 0, 0) [Black]
 ' 前景色
Const IntBCBkClr As Long = 16777215 ' 16777215 = RGB(255,255,255) [White]
 ' 背景色
 
Dim objOLEObj As OLEObject
Dim objBC As BARCODELib.BarCodeCtrl
Dim sngBcTop As Single
Dim sngBcLft As Single
Dim sngBcHgt As Single
Dim sngBcWdt As Single
Dim rngLnkCell As Range

 With Cells(lngCellBCY, lngCellBCX)
 sngBcTop = .Top + .Height * SngRelClTop
 sngBcLft = .Left + .Width * SngRelClLft
 sngBcHgt = .Height * SngRelClHgt
 sngBcWdt = .Width * SngRelClWdt
 End With
ActiveSheet.OLEObjects.Add(ClassType:="BARCODE.BarCodeCtrl.1", Link:=False, DisplayAsIcon:=False, _
 Top:=sngBcTop, Left:=sngBcLft, Height:=sngBcHgt, Width:=sngBcWdt).Select
Set objOLEObj = Selection
Set objBC = objOLEObj.Object
 With objBC
 .Style = IntBCStyle
 .SubStyle = IntBCSubst
 .Validation = IntBCValid
 .LineWeight = IntBCLnWgt
 .Direction = IntBCDrctn
 .ShowData = IntBCShwDt
 .ForeColor = IntBCFrClr
 .BackColor = IntBCBkClr
 .Refresh
 End With
 With objOLEObj
 .Visible = False
 .Placement = xlMoveAndSize ' 描画後の「セル高」変更に対し「バーコード高」が連動しない…。
 .LinkedCell = Cells(lngCellValY, lngCellValX).Address(RowAbsolute:=False, ColumnAbsolute:=False, _
 ReferenceStyle:=Application.ReferenceStyle)
 .Visible = True
 End With

End Sub
◎質問者からの返答

ありがとうございます!

ちょっと感動しました・・・。

おかげさまで、とてもうまくいきました。

頂いたコードを改造して、使用していいきたいと思います。

また、描画後の非連動はむしろそちらのほうが都合が良いです。

ありがとうございました。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ