【发布时间】：2016-10-31 09:23:01
【问题描述】：
我有 vba 代码，可以将包含从一个 excel 复制到另一个 excel。问题是在保存文件时，vba 用户窗体切换到 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
【问题讨论】：
-
您需要显示所有代码，而不仅仅是那一行。
-
您能否提供（a）一些导致问题的用户表单的屏幕截图和（b）更多代码，尤其是这个保存过程。
-
我已经添加了编码
-
我看到你很难编辑你的帖子。要制作代码块，您必须粘贴所有代码，然后突出显示它并单击此“代码示例”按钮。此外，您不需要在编辑之前保存您的帖子，您只需查看页面底部，那里就有您帖子的预览。