VBA保存中にExcelに切り替えることなくユーザーフォームを表示するユーザーフォーム

Question

私は、1つのExcelから別のExcelにコンテナをコピーするvbaコードを持っています。問題は、ファイルを保存している間、vba userformが '保存'としてダイアログボックスでExcelに切り替わることです。私は以下のコードとユーザフォームshowmodel = Falseを使用しましたが、動作しません。私たちにそれ以外の解決策があれば教えてください。そこにはかなりの混乱があります

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 

Dim myFileNameDir As String Dim myFileNameDir2 As String Dim ws As Worksheet Dim ws2 As Worksheet Dim emailID As String Dim supername As String 

myFileNameDir2 = TextBox2.Value 

Application.ScreenUpdating = False Application.DisplayAlerts = False Workbooks.Open FileName:=myFileNameDir2, UpdateLinks:=0 Application.ScreenUpdating = False Application.DisplayAlerts = False 

Set ws2 = Worksheets(1) 

myFileNameDir = TextBox1.Value 

Application.ScreenUpdating = False Application.DisplayAlerts = False Workbooks.Open FileName:=myFileNameDir, ReadOnly:=True, UpdateLinks:=0 Application.ScreenUpdating = False Application.DisplayAlerts = False 

Set ws = Worksheets(1) 

Dim cell As Range Dim II As Integer Dim III As Integer Dim Foundcell As Range 

II = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row 

For III = 2 To II emailID = ws2.Cells(III, "D").Value 

ws2.Cells(III, "P").Value = ws2.Cells(III, "A").Value & "-" & ws2.Cells(III, "C").Value 

Set Foundcell = ws.Range("AA2:AA1048576").find(What:=emailID) Do Until Foundcell Is Nothing ws2.Cells(III, "H").Value = Foundcell.Offset(, -6) ws2.Cells(III, "G").Value = Foundcell.Offset(, -17) 

Exit Do Loop 

If IsEmpty(ws2.Cells(III, "H").Value) Then 

Else supername = ws2.Cells(III, "H").Value Set Foundcell = ws.Range("D2:D1048576").find(What:=supername) Do Until Foundcell Is Nothing 

ws2.Cells(III, "I").Value = Foundcell.Offset(, 23) ws2.Cells(III, "J").Value = Foundcell.Offset(, 17) 

Exit Do Loop End If 

If IsEmpty(ws2.Cells(III, "J").Value) Then Else supername = ws2.Cells(III, "J").Value Set Foundcell = ws.Range("D2:D1048576").find(What:=supername) Do Until Foundcell Is Nothing 

ws2.Cells(III, "K").Value = Foundcell.Offset(, 23) ws2.Cells(III, "L").Value = Foundcell.Offset(, 17) 

Exit Do Loop End If 

If IsEmpty(ws2.Cells(III, "L").Value) Then 

Else supername = ws2.Cells(III, "L").Value Set Foundcell = ws.Range("D2:D1048576").find(What:=supername) Do Until Foundcell Is Nothing 

ws2.Cells(III, "M").Value = Foundcell.Offset(, 23) ws2.Cells(III, "N").Value = Foundcell.Offset(, 17) 

Exit Do Loop End If 

If IsEmpty(ws2.Cells(III, "N").Value) Then 

Else supername = ws2.Cells(III, "N").Value Set Foundcell = ws.Range("D2:D1048576").find(What:=supername) Do Until Foundcell Is Nothing 

ws2.Cells(III, "O").Value = Foundcell.Offset(, 23) 

Exit Do Loop End If 

Next III 

Application.ScreenUpdating = False Application.DisplayAlerts = False 

ws.Activate 'ActiveWorkbook.Save ActiveWorkbook.Close 

Application.ScreenUpdating = False Application.DisplayAlerts = False 

ws2.Activate ActiveWorkbook.Save ActiveWorkbook.Close 

Application.ScreenUpdating = False Application.DisplayAlerts = False 

Answer 1

...あなたが代わりに試すことができている瞬間のためとして

：

ws2.Activate ActiveWorkbook.Save ActiveWorkbook.Close 

と：

ws2.Close True 

と同じwsの場合は、必要があります（ただしコメント文が表示されます）