使用文件名单元格值保存新文件
Save new file with filename cell value
我正在努力为每个部门制定一个通用的生产时间 sheet(wbTime
),它将在所有班次和生产线上工作。我有需要输入所有必要信息的地方,所有数据都被复制到另一个工作簿 (wbLog
) 的 table 中并保存以便能够对生产数据进行分析。
但是,当它试图根据班次和机器行将实际时间 sheet 保存在适当的文件夹中时,我开始 运行 遇到问题。我让它从某些单元格中提取部分路径,文件名形成输入日期。它到达最后一行并抛出 运行 时间错误 1004 "Method 'SaveAs' of object_Worbook'failed"。
我只用 vba 玩了 2 个月,所以它可能是我看不到的小东西...
Sub TransferData()
If ActiveSheet.Range("E2").Value = "" Then
MsgBox "Operator Name Required", vbInformation, "ALERT: Missing Information"
Cancel = True
Exit Sub
End If
If ActiveSheet.Range("H2").Value = "" Then
MsgBox "Date Required", vbInformation, "ALERT: Missing Information"
Cancel = True
Exit Sub
End If
If ActiveSheet.Range("K2").Value = "" Then
MsgBox "Shift Required", vbInformation, "ALERT: Missing Information"
Cancel = True
Exit Sub
End If
If ActiveSheet.Range("M2").Value = "" Then
MsgBox "Line Required", vbInformation, "ALERT: Missing Information"
Cancel = True
Exit Sub
End If
Dim wbTime As Workbook
Set wbTime = ThisWorkbook
Dim wbData As Workbook
Dim LastRow As Long
Set wbTime = ActiveWorkbook
With wbTime.Sheets("Production Time Sheet")
LastRow = .Range("E" & .Rows.Count).End(xlUp).Row
End With
wbTime.Sheets("Production Time Sheet").Range("A6:R" & LastRow).Copy
Set wbData = Workbooks.Open("S:\Lean Carrollton Initiative\Michael\Time Sheet Data LT Test.xlsm")
Set wbData = ActiveWorkbook
wbData.Worksheets("Log").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
wbData.Close SaveChanges:=True
Dim Fname As String
Dim Path As String
Dim shft As String
Dim Line As String
Set wbTime = ActiveWorkbook
Fname = Sheets("Production Time Sheet").Range("I2").Text
shft = Sheets("Production Time Sheet").Range("Z9").Text
Line = Sheets("Production Time Sheet").Range("AC11").Text
Path = "K:\Groups\OFS Time Sheetshr Production Schedule\LT Jacketing\" & shft & Line & Fname & ".xlsx"
ActiveWorkbook.SaveAs filename:=Path, FileFormat:=xlNormal
End Sub
a) 不要使用 Range.Text
,使用 Range.Value2
.
Text
会给你 确切地 单元格中写的内容,如果单元格显示 ###
因为你的单元格要缩小以显示数字,它会给你###
.
b) 在SaveAs
前加上语句Debug.print path
,如果路径在立即window(Ctrl+G)正是您所期望的。
c) 请确保当您发出 SaveAs
-命令时,同一个文件尚未在 Excel 中打开 - 当您重复测试您的代码时经常会发生这种情况(它可能仍会打开来自上次测试)。 SaveAs 保存文件的副本并保持打开状态!
d) 当您使用 xlsx
命名文件时,请使用 FileFormat:=xlOpenXMLWorkbook
。 xlNormal
将使用旧的 Excel 文件格式保存文件,并期望 xls
作为扩展名。
e) 尝试使用 Excel 另存为对话框中的名称来保存文件,以查看文件名是否正确以及您是否有权保存文件。
您正在使用文本 2/5/2019.xlsx
作为文件名。据我所知,符号 /
不能在 Windows 中用于命名文件。
尝试使用不同的文件名。类似于:
Fname = Replace(Sheets("Production Time Sheet").Range("I2").Text,"/","-")
我正在努力为每个部门制定一个通用的生产时间 sheet(wbTime
),它将在所有班次和生产线上工作。我有需要输入所有必要信息的地方,所有数据都被复制到另一个工作簿 (wbLog
) 的 table 中并保存以便能够对生产数据进行分析。
但是,当它试图根据班次和机器行将实际时间 sheet 保存在适当的文件夹中时,我开始 运行 遇到问题。我让它从某些单元格中提取部分路径,文件名形成输入日期。它到达最后一行并抛出 运行 时间错误 1004 "Method 'SaveAs' of object_Worbook'failed"。
我只用 vba 玩了 2 个月,所以它可能是我看不到的小东西...
Sub TransferData()
If ActiveSheet.Range("E2").Value = "" Then
MsgBox "Operator Name Required", vbInformation, "ALERT: Missing Information"
Cancel = True
Exit Sub
End If
If ActiveSheet.Range("H2").Value = "" Then
MsgBox "Date Required", vbInformation, "ALERT: Missing Information"
Cancel = True
Exit Sub
End If
If ActiveSheet.Range("K2").Value = "" Then
MsgBox "Shift Required", vbInformation, "ALERT: Missing Information"
Cancel = True
Exit Sub
End If
If ActiveSheet.Range("M2").Value = "" Then
MsgBox "Line Required", vbInformation, "ALERT: Missing Information"
Cancel = True
Exit Sub
End If
Dim wbTime As Workbook
Set wbTime = ThisWorkbook
Dim wbData As Workbook
Dim LastRow As Long
Set wbTime = ActiveWorkbook
With wbTime.Sheets("Production Time Sheet")
LastRow = .Range("E" & .Rows.Count).End(xlUp).Row
End With
wbTime.Sheets("Production Time Sheet").Range("A6:R" & LastRow).Copy
Set wbData = Workbooks.Open("S:\Lean Carrollton Initiative\Michael\Time Sheet Data LT Test.xlsm")
Set wbData = ActiveWorkbook
wbData.Worksheets("Log").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
wbData.Close SaveChanges:=True
Dim Fname As String
Dim Path As String
Dim shft As String
Dim Line As String
Set wbTime = ActiveWorkbook
Fname = Sheets("Production Time Sheet").Range("I2").Text
shft = Sheets("Production Time Sheet").Range("Z9").Text
Line = Sheets("Production Time Sheet").Range("AC11").Text
Path = "K:\Groups\OFS Time Sheetshr Production Schedule\LT Jacketing\" & shft & Line & Fname & ".xlsx"
ActiveWorkbook.SaveAs filename:=Path, FileFormat:=xlNormal
End Sub
a) 不要使用 Range.Text
,使用 Range.Value2
.
Text
会给你 确切地 单元格中写的内容,如果单元格显示 ###
因为你的单元格要缩小以显示数字,它会给你###
.
b) 在SaveAs
前加上语句Debug.print path
,如果路径在立即window(Ctrl+G)正是您所期望的。
c) 请确保当您发出 SaveAs
-命令时,同一个文件尚未在 Excel 中打开 - 当您重复测试您的代码时经常会发生这种情况(它可能仍会打开来自上次测试)。 SaveAs 保存文件的副本并保持打开状态!
d) 当您使用 xlsx
命名文件时,请使用 FileFormat:=xlOpenXMLWorkbook
。 xlNormal
将使用旧的 Excel 文件格式保存文件,并期望 xls
作为扩展名。
e) 尝试使用 Excel 另存为对话框中的名称来保存文件,以查看文件名是否正确以及您是否有权保存文件。
您正在使用文本 2/5/2019.xlsx
作为文件名。据我所知,符号 /
不能在 Windows 中用于命名文件。
尝试使用不同的文件名。类似于:
Fname = Replace(Sheets("Production Time Sheet").Range("I2").Text,"/","-")