*.asc ファイルを開いて再フォーマットし、元のファイルと同じ名前 (拡張子 xls) の Excel ファイルとして保存する必要があります。
オンラインで見つけたマクロ レコーダーとコードを使用して、個々のファイルを開き、必要に応じて再フォーマットしました。コードのその部分は機能します。
Excelファイルとして保存できません。それは私に与えますRun Time error of 1004 Method ‘SaveAs’ of object ‘_Workbook’ failed
。オンラインで見つけたさまざまなコードをたくさん試しましたが (まだそこにあり、コメントアウトしただけです)、どれも機能しません。
2 つの質問:
名前を付けて保存の問題を解決するための提案を提供できますか?
1 つのフォルダー内のすべてのファイルのオープンと保存を自動化する方法を提案できますか?
ここに私が持っているコードがあります:
Sub OpenFormatSave()
'
' OpenFormatSave Macro
'
Dim StrFileName As String
Dim NewStrFileName As String
ChDir _
"C:\Users\Owner\Documents\work_LLRS\GoM\NASA_data\Satellite_files_GoM_3Dec2012"
StrFileName = Application.GetOpenFilename("NASA Files (*.asc), *.asc")
If TypeName(StrFileName) <> "Boolean" Then
Workbooks.OpenText Filename:=StrFileName, _
Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
Array(9, 1), Array(10, 1)), TrailingMinusNumbers:=True
End If
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "Year"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Day_of_Year"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Longitude"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Latitude"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Chla_mg_m-3"
Range("F1").Select
ActiveCell.FormulaR1C1 = "POC_mmolC_m-3"
Range("G1").Select
ActiveCell.FormulaR1C1 = "SPM_g_m-3"
Range("H1").Select
ActiveCell.FormulaR1C1 = "aCDOM355_m-1"
Range("I1").Select
ActiveCell.FormulaR1C1 = "DOC_mmolC_m-3"
Range("J1").Select
ActiveCell.FormulaR1C1 = "L2_flags"
Columns("A:B").Select
Selection.NumberFormat = "0"
Columns("C:D").Select
Selection.NumberFormat = "0.0000"
Columns("E:E").Select
Selection.NumberFormat = "0.000"
Columns("F:F").Select
Selection.NumberFormat = "0.0"
Columns("G:H").Select
Selection.NumberFormat = "0.000"
Columns("I:I").Select
Selection.NumberFormat = "0.0"
Columns("J:J").Select
Selection.NumberFormat = "0.00E+00"
'Mid(StrFileName, 1, InStrRev(StrFileName, ".")) = "xlsm"
'With ActiveWorkbook
'NewStrFileName = Replace(.StrFileName, ".asc", ".xls")
' .SaveAs Filename:=FullName, FileFormat:=xlsx, AddToMRU:=False
' .Close SaveChanges:=True
'End With
StrFileName = ThisWorkbook.Name
GetName:
StrFileName = Application.GetSaveAsFilename(NewStrFileName, _
fileFilter:="(*.xlsm), *.xlsm, (*.xlsx), *.xlsx,(*.xls), *.xls")
' FileMonth is the Workbook name, filter options to save a older version file
'If Dir(NewStrFileName) = "" Then
' ActiveWorkbook.SaveAs NewStrFileName
'Else
' If MsgBox("That file exists. Overwrite?", vbYesNo) = vbNo Then GoTo GetName
' Application.DisplayAlerts = False
' ActiveWorkbook.SaveAs Filename:=NewStrFileName, FileFormat:=xlsx, AddToMRU:=False
'Application.DisplayAlerts = True
'End If
'ActiveWorkbook.Close SaveChanges:=True
ActiveWorkbook.SaveAs Filename:=NewStrFileName, FileFormat:=xlsx, CreateBackup:=False
'With ThisWorkbook
'FullName = Replace(.StrFileName, ".asc", ".xlsx")
'.Save
'.SaveAs StrFileName, FileFormat:=xlsx
'.Close
'SaveChanges:=True
'End With
'StrFileName = Split(ActiveWorkbook.FullName, ".xls")(0)
'ActiveWorkbook.SaveAs Filename:="...", FileFormat:=xlsx, AddToMRU:=False
'ActiveWorkbook.Close SaveChanges:=True
'ActiveWorkbook.Save
End Sub