VBA Excel宏另存为brain stall

Question

我正试图输入一个文件名来保存Excel工作表，并选择更改，除了从单元格中提取文件名并输入首选文件名代码外，所有操作都在进行

Public Sub EnterInfo()
Dim ROOM As String
Dim SiteName As String
Dim SiteID As String
Dim FSR As String
ROOM = InputBox("What is Room?", "Room Numner")
SiteName = InputBox("What is the Site Name?", "Site Name")
SiteID = InputBox("What is the Site ID?", "Site ID")
FSR = InputBox("What is your Name?", "Your Name")
Range("A3").Value = ROOM
Range("B3").Value = SiteName
Range("C3").Value = SiteID
Range("G3").Value = FSR
Range("D3").Value = Date
Dim xWb As Workbook
Dim xNewWb As Workbook
Dim xFileName As String
Dim xFolderPath As Variant
Dim xDlg As FileDialog
Set xWb = ActiveWorkbook

*'> FileName = "needed' A3+C3+D3... problem here, I need these cells to added to next section*

xFileName = InputBox("Enter file name here, : ")
If xFileName = "" Then Exit Sub
Set xDlg = Application.FileDialog(msoFileDialogFolderPicker)
If xDlg.Show = -1 Then
xFolderPath = xDlg.SelectedItems(1)
xWb.ActiveSheet.Range("b1:H41").Select
Selection.Copy
Set xNewWb = Workbooks.Add
Range("b1:H41").PasteSpecial
xNewWb.SaveAs xFolderPath & "" & xFileName & ".xlsx"
xNewWb.Close
End If
End Sub

如有任何帮助，将不胜感激

Answer 1

最好的学习方法是获得好的例子，使用数组与变量重写脚本，并最小化与表单的交互，而是在内存中移动它。

Option Explicit
Option Base 1

Public Sub EnterInfo()
Dim i As Long, arr, topics, xFileName As String
'instead of hardcoding vars we store the messages in an array
topics = Array( _
"What is Room?", _
"What is the Site Name?", _
"What is the Site ID?", _
"What is your Name?" _
)

'with the values in an array we can now automate the iterations and write the responses and to all manipulations like get responses, setup the filename string, ...
ReDim arr(1 To UBound(topics), 1 To 1)
For i = 1 To UBound(topics)
arr(i, 1) = InputBox(topics(i))
xFileName = xFileName & CStr(arr(i, 1))
Next i

'all has been done in memory so we write to sheet
With Sheet2
.Range(.Cells(3, 1), .Cells(3, UBound(arr))).Value2 = arr
End With

'Get data for new workbook into an array
Dim arr2
arr2 = Sheet2.Range("B1:H41").Value2

'save file in user selected folder
Dim sFolder As String, xNewWb As Workbook
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then ' if OK is pressed
sFolder = .SelectedItems(1)
Set xNewWb = Workbooks.Add
With xNewWb.Sheets(1)
.Range(.Cells(1, 2), .Cells(41, 8)).Value2 = arr2
End With
xFileName = InputBox("Enter file name here, : ", , xFileName)
xNewWb.SaveAs sFolder & "" & xFileName & ".xlsx"
xNewWb.Close
End If
End With
End Sub

继续编码，如果您有任何其他问题，请不要犹豫。