| |
いつもお世話になっております。
困ったことがありますので教えてください。
エクセル２０００で簡単なシステムを作りました。
これには、複数の様々なシートがあり、シートにはそれぞれコマンドボタン、テキストボックス、ラベル、コンボボックスなどが付いています。
この複数のシートのうち、保存したいシート（アクティブシート）だけを保存できるようにしていて、シートの保存ボタンを押すと、そのシートだけがシステムの外に保存できるようにしました。
これをエクセル２００３で動かすと、バージョンの違いによりプログラムがエラーになりうごきません。
シートのモジュールを削除するコードの部分が原因だと思います。
プログラムは下記のとおりです。
エクセル２００３で対応できる方法があればご教示願います。
Sub アクティブシート保存()
Dim SheetName As String
Dim HozonSheetName As String
SheetName = ActiveSheet.Name
HozonSheetName = "コピー" & "_" & SheetName
'アクティブシートを新規ブックにコピー
ActiveSheet.Copy
'コピー先のシートのモジュールを削除
Dim myVBComp
For Each myVBComp In ActiveWorkbook.VBProject.VBComponents
If myVBComp.Type = 100 Then
'Documentモジュール(ThisWorkbokやSheet)なら消去
With myVBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Else
'Documentモジュール以外(標準モージュール、クラスモジュール、Formなど)なら削除
Application.VBE.ActiveVBProject.VBComponents.Remove myVBComp
End If
Next myVBComp
'コピー先シートのコマンドボタン等のオブジェクトを削除
Dim objShape As Shape
'オブジェクトの名前の先頭３文字は、コマンドボタンがcmd、テキストボックスがtxt、ラベルがlbl、コンボボックスがcmbと付いている
For Each objShape In ActiveSheet.Shapes
'コマンドボタンの場合
If Left(objShape.Name, 3) = "cmd" Then
objShape.Select
Selection.Delete
'テキストボックスの場合
ElseIf Left(objShape.Name, 3) = "txt" Then
objShape.Select
Selection.Delete
'ラベルの場合
ElseIf Left(objShape.Name, 3) = "lbl" Then
objShape.Select
Selection.Delete
'コンボボックスの場合
ElseIf Left(objShape.Name, 3) = "cmb" Then
objShape.Select
Selection.Delete
End If
Next objShape
'コピーしたシートを保存するかどうかの確認
Dim DlgAnswer As Boolean
DlgAnswer = Application.Dialogs(xlDialogSaveAs).Show(HozonSheetName)
If DlgAnswer = True Then
ActiveWorkbook.Close
Else
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
End If
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
