Question

我有vba代码，它将包含从一个excel复制到另一个excel。问题是在保存文件时，vba userform切换到excel，对话框为'save'。我使用了下面的代码和userform 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的相同，如果你需要它（但我看到评论声明）

VBA Userform显示userform而不保存时切换到excel

1 个答案: