| |
Jakaさん ありがとうございます
>なんせ、マカフィ―に資料が全部消されて残ってないんです。
>テキストに書いておいたものも。
時折、見かけることが有るような気がしましたが
こうして、生に聞くと、実際に削除されてしまうんですね〜
やはり、こういう操作は・・・避けるようにしたいけど・・・
データ入力補助でシートイベントを多用していて
うまくDTブックとマクロブックが分離できなかったみたいなです
時間が取れたときにブックの分離について再考してみたいと思いますが時間がないです・・・
ただ、本件は、入れ替えが済めば重過ぎるので、修正する気にはなりません・・・
です
>モジュールを削除した後、１度VBProjectの中を１番最初に提示した方法で空回りさせてみてください。
空回りですか
了解です
ハチさん ありがとうございます
>上書きされずに違うモジュール名でImportされましたが、
すいません、書き間違いです
Module9.basに追加でModule91.basとなります
>そのあたりにコードのバグとかないですか？
症状は、アップ頂いたpopoと同じものになります。
以下は切り分けのためpopoでの検証結果1-3です
で
1）-2）時は、basが残るエラーがあったのですが
3）時に作成途中になぜかエラーが出なくなってしまいました
で、動作確認しようとするとフォームが古いままで動作せず
フォーム他入れ替えも組み込んでしまいました。
1）-2）は、対象ブックを開いたまま実行
3)はコードからブックを開いています
で、対象ブックの途中保存も不要となりました
原因がはっきりつかめていないのでなんともですが・・・
コメント頂けるとうれしいですよろしくお願いいたします
'1）上書き時 (途中でsaveしない場合)
Sub popo()
Dim wb As Workbook
Dim vbc As Object
PAS = CreateObject("WScript.Shell").SpecialFolders("Desktop")
With Workbooks("TG_BOOK.xls").VBProject
'basが11個表示
DoEvents
For Each vbc In .VBComponents
If vbc.Type = 1 Then
.VBComponents.Remove vbc
End If
Next
'Module9.basが残
DoEvents
With ActiveWorkbook.VBProject
For Each vbc In .VBComponents
Next
End With
'Module9.basが残
DoEvents
With ActiveWorkbook.VBProject
For Each vbc In .VBComponents
Next
End With
'Module9.basが残
DoEvents
For I = 1 To 11 '←ここでストップ？
.VBComponents.Import CreateObject("WScript.Shell").SpecialFolders("Desktop") & NEW_MD & I & ".bas"
Next
'11bas+Module91.basが追加
DoEvents
End With
End Sub
'2)上書き時 (途中でsaveした場合)
Sub popo()
Dim wb As Workbook
Dim vbc As Object
PAS = CreateObject("WScript.Shell").SpecialFolders("Desktop")
With Workbooks("TG_BOOK.xls").VBProject
'basが11個表示
DoEvents
For Each vbc In .VBComponents
If vbc.Type = 1 Then
.VBComponents.Remove vbc
End If
Next
'Module9.basが残
DoEvents
With ActiveWorkbook.VBProject
For Each vbc In .VBComponents
Next
End With
'Module9.basが残
DoEvents
Workbooks("TG_BOOK.xls").Save '上書き保存
'Module9.basが残
DoEvents
With ActiveWorkbook.VBProject
For Each vbc In .VBComponents
Next
End With
'Module9.basが残
DoEvents
For I = 1 To 11 '←ここでストップ？
.VBComponents.Import CreateObject("WScript.Shell").SpecialFolders("Desktop") & NEW_MD & I & ".bas"
Next
'11bas+Module91.basが追加
DoEvents
End With
End Sub
'3）エラーがなくなりました
Sub popo()
Dim wb As Workbook
'Dim vbc As Object
Dim vbcs As VBIDE.VBComponents
Dim vbc As VBComponent
'PAS = CreateObject("WScript.Shell").SpecialFolders("Desktop")
Application.EnableEvents = False
On Error Resume Next
Workbooks.Open ("\\TG_FLD\TG_BOOK.xls")
On Error GoTo 0
Application.EnableEvents = True
With Workbooks("TG_BOOK.xls").VBProject
'basが11個表示
DoEvents
'For Each vbc In .VBComponents
'If vbc.Type = 1 Then
' .VBComponents.Remove vbc
'End If
Set vbcs = Workbooks("TG_BOOK.xls").VBProject.VBComponents
For Each vbc In vbcs
Select Case vbc.Type
'Case vbext_ct_StdModule, vbext_ct_ClassModule, vbext_ct_ClassModule
Case vbext_ct_StdModule, vbext_ct_ClassModule, vbext_ct_MSForm
vbcs.Remove vbc
Case vbext_ct_Document
With vbc.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
vbcs.Remove vbc
End Select
Next
'basが無し
DoEvents
'For I = 1 To 11 '←ここでストップ？
' .VBComponents.Import CreateObject("WScript.Shell").SpecialFolders("Desktop") & NEW_MD & I & ".bas"
'Next
Call AllMdlImport("TG_BOOK.xls", "C:\Documents and Settings\NEW_MD")
DoEvents
' Workbooks("TG_BOOK.xls").Save '上書き保存
End With
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
