VBA CodeModuleでinsertした時の変数値

いつもお世話になります

vbaにおいてシートに作表後、セルのクリックに対して図を貼りつけるコードをそシートにinsertしました
しかし、Public変数で定義された値が繁栄されません
仕方なく再定義していますが、その変数が定義される前にinsertしなければいけないのか良く分かりません、CodeModuleの変数値についてご教授願えれば幸いです


Sheets(Mysheet1(1)).Activate
moji = Book2.VBProject.VBComponents(Book2.VBProject.VBComponents.Count).Name

With Book2.VBProject.VBComponents.Item(moji).CodeModule
.insertlines 1, "Public Sub Worksheet_SelectionChange(ByVal Target As Range)"
.insertlines 2, ""
.insertlines 3, "Dim irow, icol As Integer"
.insertlines 4, ""
.insertlines 5, " irow = ActiveCell.Row"　　　　　　　　Public変数にしたい
.insertlines 6, " icol = ActiveCell.Column" ↓
.insertlines 7, " if icol < 7 or icol > 9 or irow < 9 or irow > 100 Then"
.insertlines 8, " if Zubango2<>"""" then"
.insertlines 9, " ActiveSheet.Shapes.Range(Array(Zubango2)).Select"
.insertlines 10, " Selection.Cut"
.insertlines 11, " end if"
.insertlines 12, " Zubango2 = """" "
.insertlines 13, " Exit Sub "
.insertlines 14, " End If"
.insertlines 15, ""
.insertlines 16, ""
.insertlines 18, " moji = Mcell(irow, icol+4)"
.insertlines 19, " SansyoSheet=""参照データ"" "　←再定義している
.insertlines 20, " Mysheet1(1)=""水平ばねL"" "　←再定義している
.insertlines 21, ""
.insertlines 22, " if Zubango2<>"""" then"
.insertlines 23, " ActiveSheet.Shapes.Range(Array(Zubango2)).Select"
.insertlines 24, " Selection.Cut"
.insertlines 25, " Zubango2 = """" "
.insertlines 25, " end if"
.insertlines 26, ""
.insertlines 30, " Application.ScreenUpdating = False "
.insertlines 31, " ActiveWorkbook.Sheets(SansyoSheet).Activate"
.insertlines 32, " ActiveSheet.Shapes.Range(Array(""図 2"")).Visible = msoTrue"
.insertlines 33, " ActiveSheet.Shapes.Range(Array(""図 2"")).Select"
.insertlines 34, " Selection.Copy"
.insertlines 35, " ActiveWorkbook.Sheets(Mysheet1(1)).Activate"
.insertlines 36, " Range(moji).Select"
.insertlines 37, " ActiveSheet.Paste"
.insertlines 38, " Selection.Name = ""図B"" "
.insertlines 39, " Zubango2 = ActiveSheet.Shapes(""図B"").Name"
.insertlines 40, " ActiveWorkbook.Sheets(SansyoSheet).Activate"
.insertlines 41, " ActiveSheet.Shapes.Range(Array(""図 2"")).Visible = msoFalse"
.insertlines 42, " ActiveWorkbook.Sheets(Mysheet1(1)).Activate"
.insertlines 43, " Application.ScreenUpdating = True"
.insertlines 44, ""
.insertlines 45, "End Sub"

End With

以上、よろしくお願いします

No.1 ベストアンサー 回答者： WindFaller 回答日時： 2016/09/30 23:57

こんばんは。

失礼ながら、この内容について、よく理解されているのでしょうか。既存のブックに入れるようになっているマクロですが、イベント・ドリブン型のマクロ自体に、少し問題があるようです。この質問では、アウト・トピですから、手をつけませんが、できるなら、アドインにするなり、クラス・インスタンスのほうが楽だと思います。

それと、このコードをよく読むと、考え方が間違えてますね。

>With Book2.VBProject.VBComponents.Item(MySheet1(1)).CodeModule

VBComponentsの中身は、ObjectName です。シート名ではありません。つまり、シート名からオブジェクト名を取り出してあげないといけません。はっきり言って、こういうことで、ややこしくてしょうがないですね。


'標準モジュール

Dim mySheet1(1 To 3)
Dim moji As String
Sub TestSheet1Enter() 'ここが始まり
　mySheet1(1) = "水平ばねL"
　moji = mySheet1(1)
　Call InsertMacro
End Sub

Private Sub InsertMacro()
　　Dim Book2 As Workbook
　　Dim ObjName As String
　　'

　　Set Book2 = Workbooks("Book2.xlsm")
　　Book2.Activate
　　On Error Resume Next
　　'VBComponents 引数になるのは、オブジェクト名です。Sheet名では選択できません。
　　ObjName = Book2.Worksheets(mySheet1(1)).CodeName
　　Sheets(mySheet1(1)).Activate
　　moji = Book2.VBProject.VBComponents(Book2.VBProject.VBComponents.Count).Name

　　With Book2.VBProject.VBComponents.Item(moji).CodeModule
　　　　.insertLines 1, "Public irow As Long"
　　　　.insertLines 2, "Public icol As Long"
　　　　.insertLines 3, "Public Const SansyoSheet As String =""SansyoSheet"""
　　　　.insertLines 5, "Public Mysheet1(1 to 3)"
　　　　.insertLines 6, "Public mCell As Range"
　　　　.insertLines 7, "Sub enterArray()"
　　　　.insertLines 8, "mySheet1(1) = ""水平ばねL"""
　　　　.insertLines 9, "End Sub"

　　End With

　　With Book2.VBProject.VBComponents.Item(ObjName).CodeModule
　　　　.insertLines 1, "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
　　　　.insertLines 2, ""
　　　　.insertLines 3, "Dim irow, icol As Integer"
　　　　.insertLines 4, ""
　　　　.insertLines 5, " irow = ActiveCell.Row"　　'　Public変数にしたい
　　　　.insertLines 6, " icol = ActiveCell.Column"　　'↓
　　　　.insertLines 7, " if icol < 7 or icol > 9 or irow < 9 or irow > 100 Then"
　　　　.insertLines 8, " if Zubango2<>"""" then"
　　　　.insertLines 9, " ActiveSheet.Shapes.Range(Array(Zubango2)).Select"
　　　　.insertLines 10, " Selection.Cut"
　　　　.insertLines 11, " end if"
　　　　.insertLines 12, " Zubango2 = """" "
　　　　.insertLines 13, " Exit Sub "
　　　　.insertLines 14, " End If"
　　　　.insertLines 15, ""
　　　　.insertLines 16, ""
　　　　.insertLines 18, " moji = Mcell(irow, icol+4)"
　　　　.insertLines 19, "' SansyoSheet=""参照データ"" "　　'←再定義している
　　　　.insertLines 20, "' Mysheet1(1)=""水平ばねL"" "　　'　←再定義している
　　　　.insertLines 21, ""
　　　　.insertLines 22, " if Zubango2<>"""" then"
　　　　.insertLines 23, " ActiveSheet.Shapes.Range(Array(Zubango2)).Select"
　　　　.insertLines 24, " Selection.Cut"
　　　　.insertLines 25, " Zubango2 = """" "
　　　　.insertLines 25, " end if"
　　　　.insertLines 26, ""
　　　　.insertLines 30, " Application.ScreenUpdating = False "
　　　　.insertLines 31, " ActiveWorkbook.Sheets(SansyoSheet).Activate"
　　　　.insertLines 32, " ActiveSheet.Shapes.Range(Array(""図 2"")).Visible = msoTrue"
　　　　.insertLines 33, " ActiveSheet.Shapes.Range(Array(""図 2"")).Select"
　　　　.insertLines 34, " Selection.Copy"
　　　　.insertLines 35, " ActiveWorkbook.Sheets(Mysheet1(1)).Activate"
　　　　.insertLines 36, " Range(moji).Select"
　　　　.insertLines 37, " ActiveSheet.Paste"
　　　　.insertLines 38, " Selection.Name = ""図B"" "
　　　　.insertLines 39, " Zubango2 = ActiveSheet.Shapes(""図B"").Name"
　　　　.insertLines 40, " ActiveWorkbook.Sheets(SansyoSheet).Activate"
　　　　.insertLines 41, " ActiveSheet.Shapes.Range(Array(""図 2"")).Visible = msoFalse"
　　　　.insertLines 42, " ActiveWorkbook.Sheets(Mysheet1(1)).Activate"
　　　　.insertLines 43, " Application.ScreenUpdating = True"
　　　　.insertLines 44, ""
　　　　.insertLines 45, "End Sub"
　　End With
　　MsgBox "Finished!"
End Sub

この回答へのお礼

ありがとうございます
非常に勉強になりました

鋭い指摘、ご指南に心から感謝します
これからもよろしくお願いします

お礼日時：2016/10/01 13:00