ｴｸｾﾙVBA(ﾏｸﾛ)でﾊﾞｰｺｰﾄﾞを生成する方法を教えて下さい｡ｴｸｾﾙでﾊﾞｰｺｰﾄﾞを作る ?ｺﾝﾄﾛｰﾙ版? http://takashixxx.blog88.fc2.com/blog-entry-23.ht…

ｴｸｾﾙ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)
でﾊﾞｰｺｰﾄﾞを次々に作成するﾏｸﾛを作りたいのですが､代わりに作っていただけると助かります｡ｴﾗｰの原因の指摘だけでも構いません｡

ﾘｽﾄ中にもｺﾒﾝﾄ入れていますが､一旦描画されたﾊﾞｰｺｰﾄﾞの高さが

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

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

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

' 参考文書 [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