Excel 创建泛型引用表：集合是正确的方法吗？
我已经创建了一对可重用的子例程，它们一起工作，根据需要以不同的扩展名保存文件 第一个子节点接收目录路径、文件名和所需的Excel扩展名。然后，它调用第二个子系统以查找正确的Excel FileFormat编号，并使用它以新格式保存文件：Excel 创建泛型引用表：集合是正确的方法吗？,excel,vba,Excel,Vba,我已经创建了一对可重用的子例程，它们一起工作，根据需要以不同的扩展名保存文件 第一个子节点接收目录路径、文件名和所需的Excel扩展名。然后，它调用第二个子系统以查找正确的Excel FileFormat编号，并使用它以新格式保存文件： Sub SaveFileWithNewExtension(DirectoryPath As String, NameOfFile As String, ExtensionToUse As String) Dim ExcelFileFormatNumber
Sub SaveFileWithNewExtension(DirectoryPath As String, NameOfFile As String, ExtensionToUse As String)
Dim ExcelFileFormatNumber As String
GetExcelFormatNumber ExtensionToUse, ExcelFileFormatNumber
ActiveWorkbook.SaveAs DirectoryPath & "\" & NameOfFile & ExtensionToUse, FileFormat:=ExcelFileFormatNumber
End Sub
Sub GetExcelFormatNumber(Extension As String, Optional Number As String, Optional ExcelFormat As String)
'http://msdn.microsoft.com/en-us/library/office/ff198017.aspx
'http://www.rondebruin.nl/mac/mac020.htm
Dim ExtensionReference As New Collection
ExtensionReference.Add Array("51", "xlOpenXMLWorkbook"), ".xlsx"
ExtensionReference.Add Array("52", "xlOpenXMLWorkbookMacroEnabled"), ".xlsm"
ExtensionReference.Add Array("50", "xlExcel12"), ".xlsb"
ExtensionReference.Add Array("56", "xlExcel8"), ".xls"
On Error GoTo NoMatch:
ExcelFormat = ExtensionReference.Item(Extension)(1)
Number = ExtensionReference.Item(Extension)(0)
Exit Sub
NoMatch:
msgbox "No Matching Extension was Found in the ExcelExtensionsAndNumbers Collection"
End Sub
代码已经被修改为用例而不是集合，并更好地处理错误（正如Siddharth Rout重写代码所温和地建议的那样）。这是可行的，案例结构在我看来更有意义：
Public Sub SaveFileWithNewExtension(DirectoryPath As String, NameOfFile As String, ExtensionToUse As String)
Dim ExcelFileFormatNumber As String
GetExcelFormatNumber ExtensionToUse, ExcelFileFormatNumber
If ExcelFileFormatNumber <> "" Then
ActiveWorkbook.SaveAs DirectoryPath & "\" & NameOfFile & ExtensionToUse, FileFormat:=ExcelFileFormatNumber
Else
msgbox "Invalid file extension. Case does not exist."
End If
End Sub
Public Sub GetExcelFormatNumber(ExtensionToFind As String, Optional Number As String, Optional ExcelFormat As String)
'reference - http://msdn.microsoft.com/en-us/library/office/ff198017.aspx
'reference - http://www.rondebruin.nl/mac/mac020.htm
Select Case ExtensionToFind
Case ".xlsx": Number = "51"
ExcelFormat = "xlOpenXMLWorkbook"
Case ".xlsm": Number = "52"
ExcelFormat = "xlOpenXMLWorkbookMacroEnabled"
Case ".xlsb": Number = "50"
ExcelFormat = "xlExcel12"
Case ".xls": Number = "56"
ExcelFormat = "xlExcel8"
Case ".csv": Number = "6"
ExcelFormat = "xlCSV"
Case Else: Number = ""
ExcelFormat = ""
End Select
End Sub
Public Sub-SaveFileWithNewExtension（DirectoryPath作为字符串，NameOfFile作为字符串，ExtensionToUse作为字符串）
Dim ExcelFileFormatNumber作为字符串
GetExcelFormatNumber扩展使用，ExcelFileFormatNumber
如果ExcelFileFormatNumber为“”，则
ActiveWorkbook.SaveAs目录路径&“\”文件名和扩展名使用，文件格式：=ExcelFileFormatNumber
其他的
msgbox“文件扩展名无效。大小写不存在。”
如果结束
端接头
公共子GetExcelFormatNumber（ExtensionFind作为字符串，可选数字作为字符串，可选ExcelFormat作为字符串）
“参考-http://msdn.microsoft.com/en-us/library/office/ff198017.aspx
“参考-http://www.rondebruin.nl/mac/mac020.htm
选择Case ExtensionToFind
案例“.xlsx”：编号=“51”
ExcelFormat=“xlOpenXMLWorkbook”
案例“.xlsm”：编号=“52”
ExcelFormat=“xlOpenXMLWorkbookMacroEnabled”
案例“.xlsb”：编号=“50”
ExcelFormat=“xlExcel12”
案例“.xls”：编号=“56”
ExcelFormat=“xlExcel8”
Case“.csv”：Number=“6”
ExcelFormat=“xlCSV”
Case-Else:Number=“”
ExcelFormat=“”
结束选择
端接头
我同意。对于仅4个extn，数组将是一种过度杀伤力。我宁愿在函数中使用Select Case。见下文
未经测试
Sub SaveFileWithNewExtension(DirectoryPath As String, _
NameOfFile As String, _
ExtensionToUse As String)
Dim ExcelFileFormatNumber As Long
ExcelFileFormatNumber = GetExcelFormatNumber(ExtensionToUse)
If ExcelFileFormatNumber <> 0 Then
ActiveWorkbook.SaveAs _
DirectoryPath & _
"\" & _
NameOfFile & ExtensionToUse, _
FileFormat:=ExcelFileFormatNumber
Else
MsgBox "Invalid Extenstion:"
End If
End Sub
Function GetExcelFormatNumber(Extn As String) As Long
'~~> FileFormat
Select Case UCase(Extn)
Case "XLS": GetExcelFormatNumber = 56
Case "XLSX": GetExcelFormatNumber = 51
Case "XLSM": GetExcelFormatNumber = 52
Case "XLSB": GetExcelFormatNumber = 56
'~~> Add for more... like csv etc
End Select
End Function
Sub-SaveFileWithNewExtension（DirectoryPath作为字符串_
将文件命名为字符串_
扩展名（用作字符串）
Dim ExcelFileFormatNumber尽可能长
ExcelFileFormatNumber=GetExcelFormatNumber（扩展使用）
如果ExcelFileFormatNumber为0，则
ActiveWorkbook.SaveAs_
目录路径&_
"\" & _
文件和扩展名使用_
FileFormat:=ExcelFileFormatNumber
其他的
MsgBox“无效扩展名：”
如果结束
端接头
函数GetExcelFormatNumber（Extn作为字符串）的长度
“~~>文件格式
选择案例UCase（Extn）
案例“XLS”：GetExcelFormatNumber=56
案例“XLSX”：GetExcelFormatNumber=51
案例“XLSM”：GetExcelFormatNumber=52
案例“XLSB”：GetExcelFormatNumber=56
“~~>有关详细信息，请添加…”。。。比如csv等等
结束选择
端函数
以下是一个相当通用的解决方案（从Excel 2010开始）：
如代码中所述，根据可用的参考文档，所有转换都应在理论上可行，但并非所有转换都经过测试（截至2014年8月）。如能在全面测试中得到任何帮助，将不胜感激。如果发现任何错误的转换，请在此处发布回复，更正将并入。您的方法正确。看看用类实例替换这些数组的方法。@amadeus:谢谢！我一直在想类对象，现在看来是我开始学习的机会了。很明显，我必须稍微处理一下类的事情来学习如何调用类对象，但是一旦我这样做了，它看起来会更好。谢谢Select Case
确实工作得更好，尤其是当我意识到我可以用同一个Case设置多个值时。有道理，但我以前从未这样做过。一个问题：我注意到您将GetExcelFormatNumber定义为一个函数，而不是一个子函数。您的理由是什么？我不完全清楚定义一个函数和一个公共子函数什么时候有意义，在@amadeus提到类之后，我将把类定义添加到那个列表中。函数返回值，子函数不返回值。因此，我使用了一个函数来返回文件格式。关于你的另一点，比如数组，类对于这一点来说也是一种过分的杀伤力：）
Function GetFileFormat(FileExt As String) As Long
'Converts the specified file-extension string to its corresponding file-format code value, if known. If the
'file-format value for the specified extension is unknown, then a zero value is returned.
'
'WARNING: some extension strings map to multiple possible file-format values. Such ambiguous specifications
'are handled according to the following priority:
'
' 1) If the ambiguity is related to older vs. more recent versions of the file type, such as xlDBF4
' vs. xlDBF3 vs. xlDBF2, the most recent version is returned (xlDBF4).
'
' 2) If the ambiguity is related to more general vs. more specific versions of the file type, such as
' xlCurrentPlatformText vs. xlTextMSDOS vs. xlTextWindows and there is a Excel version-specific default
' option (xlCurrentPlatformText in this case) then the version-specific default is returned.
'
' 3) If the ambiguity is related to more general vs. more specific versions and there is no Excel version-
' specific default, such as xlCSV vs. xlCSVMSDOS vs. xlCSVWindows, the most general version is returned
' (xlCSV).
'
' 4) "xls" files present a special case of all of the above. See the code commentary for that
' case, below.
'
' If you need a different default conversion, then edit the code accordingly.
'
'NOTE: Though they should all work in theory, based on the available reference documentation, not all of
' these conversions have been tested (as of August 2014)!
'
'AUTHOR: Peter Straton
'
'*************************************************************************************************************
'The following FileFormat constants are available in all versions from Excel 2003 onward, so they are listed
'here for reference but there is no need to actually declare them. If there is a possibility of running this
'code under an earlier version of Excel, then experiment and un-comment any undefined constants.
'Const xlAddIn As Long = 18 '.xla
'Const xlAddIn8 As Long = 18 '.xla
'Const xlCSV As Long = 6 '.csv
'Const xlCSVMac As Long = 22 '.csv
'Const xlCSVMSDOS As Long = 24 '.csv
'Const xlCSVWindows As Long = 23 '.csv
'Const xlCurrentPlatformText As Long = -4158 '.txt
'Const xlDBF2 As Long = 7 '.dbf
'Const xlDBF3 As Long = 8 '.dbf
'Const xlDBF4 As Long = 11 '.dbf
'Const xlDIF As Long = 9 '.dif
'Const xlExcel12 As Long = 50 '.xlsb
'Const xlExcel2 As Long = 16 '.xls
'Const xlExcel2FarEAst As Long = 27 '.xls
'Const xlExcel3 As Long = 29 '.xls
'Const xlExcel4 As Long = 33 '.xls
'Const xlExcel4Workbook As Long = 35 '.xlw
'Const xlExcel5 As Long = 39 '.xls
'Const xlExcel7 As Long = 39 '.xls
'Const xlExcel8 As Long = 56 '.xls
'Const xlExcel9795 As Long = 43 '.xls
'Const xlHtml As Long = 44 '.htm, .html
'Const xlIntlAddIn As Long = 26 '
'Const xlIntlMacro As Long = 25 '
'Const xlNormal As Long = -4143 '
'Const xlOpenDocumentSpreadsheet As Long = 60 '.ods
'Const xlOpenXMLAddIn As Long = 55 '.xlam
'Const xlOpenXMLTemplate As Long = 54 '.xltx
'Const xlOpenXMLTemplateMacroEnabled As Long = 53 '.xltm
'Const xlOpenXMLWorkbook As Long = 51 '.xlsx
'Const xlOpenXMLWorkbookMacroEnabled As Long = 52 '.xlsm
'Const xlSYLK As Long = 2 '.slk
'Const xlTemplate As Long = 17 '.xlt
'Const xlTemplate8 As Long = 17 '.xlt
'Const xlTextMac As Long = 19 '.txt
'Const xlTextMSDOS As Long = 21 '.txt
'Const xlTextPrinter As Long = 36 '.prn
'Const xlTextWindows As Long = 20 '.txt
'Const xlUnicodeText As Long = 42 '.txt
'Const xlWebArchive As Long = 45 '.mht, .mhtml
'Const xlWJ2WD1 As Long = 14 '
'Const xlWJ3 As Long = 40 '
'Const xlWJ3FJ3 As Long = 41 '
'Const xlWK1 As Long = 5 '.wk1
'Const xlWK1ALL As Long = 31 '.wk1
'Const xlWK1FMT As Long = 30 '.wk1
'Const xlWK3 As Long = 15 '.wk3
'Const xlWK3FM3 As Long = 32 '.wk3
'Const xlWK4 As Long = 38 '.wk4
'Const xlWKS As Long = 4 '.wks
'Const xlWorkbookDefault As Long = 51 '.xlsx
'Const xlWorkbookNormal As Long = -4143 '
'Const xlWorks2FarEAst As Long = 28 '.wks
'Const xlWQ1 As Long = 34 '.wq1
'Const xlXMLData As Long = 47 '.xml
'Const xlXMLSpreadsheet As Long = 46 '.xml
'The following FileFormat constants are not available in any versions of Excel up to and including Excel 2010,
'(VBA7) so declare them in all cases.
Const xlOpenXMLStrictWorkbook As Long = 61 '.??? (Exists in Excel 2013 and later versions)
Const UnsupportedPDF As Long = 57 'As of 8/2014, this value works while debugging in VBE but
'fails otherwise!
'The following FileFormat constants are not available in versions of Excel prior to Excel 2007 (VBA7),
'so declare them in all versions earlier than VBA7.
#If VBA7 = 0 Then 'Can't use the "Not" operator since defined built-in compiler constants evaluate
'to 1 (&H0001), not True (&HFFFF). So (Not 1) = &HFFFE, which is also True since it
'isn't &H0000 (False).
Const xlAddIn8 As Long = 18 '.xla
Const xlExcel12 As Long = 50 '.xlsb
Const xlExcel8 As Long = 56 '.xls
Const xlOpenDocumentSpreadsheet As Long = 60 '.ods
Const xlOpenXMLAddIn As Long = 55 '.xlam
Const xlOpenXMLTemplate As Long = 54 '.xltx
Const xlOpenXMLTemplateMacroEnabled As Long = 53 '.xltm
Const xlOpenXMLWorkbook As Long = 51 '.xlsx
Const xlOpenXMLWorkbookMacroEnabled As Long = 52 '.xlsm
Const xlTemplate8 As Long = 17 '.xlt
Const xlWorkbookDefault As Long = 51 '.xlsx
#End If
'Though web references suggest xlXMLData should be defined in Excel 2003 (VBA6) only, it isn't actually
'defined in my copy of VBA6, running under Excel 2003. So don't actually restrict this declaration to
'versions later than Excel 2003.
' #If VBA6 = 0 And VBA7 = 1 Then 'All versions later than Excel 2003 (See note about "Not" operator, above)
Const xlXMLData As Long = 47 '.xml
' #End If
Select Case UCase(Replace(FileExt, ".", ""))
Case "CSV": GetFileFormat = xlCSV
Case "DBF": GetFileFormat = xlDBF4
Case "DIF": GetFileFormat = xlDIF
Case "HTM": GetFileFormat = xlHtml
Case "HTML": GetFileFormat = xlHtml
Case "MHT": GetFileFormat = xlWebArchive
Case "MHTML": GetFileFormat = xlWebArchive
Case "ODS": GetFileFormat = xlOpenDocumentSpreadsheet
Case "PDF": GetFileFormat = UnsupportedPDF
Case "PRN": GetFileFormat = xlTextPrinter
Case "SLK": GetFileFormat = xlSYLK
Case "TXT": GetFileFormat = xlCurrentPlatformText
Case "WK1": GetFileFormat = xlWK1ALL
Case "WK3": GetFileFormat = xlWK3FM3
Case "WK4": GetFileFormat = xlWK4
Case "WKS": GetFileFormat = xlWKS
Case "WQ1": GetFileFormat = xlWQ1
Case "XLA": GetFileFormat = xlAddIn
Case "XLAM": GetFileFormat = xlOpenXMLAddIn
Case "XLS"
If CInt(Application.Version) >= Excel_2007_VNum Then
'Excel 2007 and later versions:
GetFileFormat = xlExcel8 '= 56, an ".xls" file
Else
'Excel 2003:
'The xlExcel8 value (56) isn't actually recognized by Excel versions 8 through 11 (Excel 97
'through 2003), so use of it will fail. And, the default used when the SaveAs method's
'FileFormat argument isn't defined (for either a new file or existing) is the file format
'of the last successfully saved file, whatever that might be! (Note that Excel VBA Help is
'misleading on this point.) So, in this case, return xlNormal (-4143) which always defaults
'to an ".xls" file type when the code is run under Excel 2003 and earlier versions.
GetFileFormat = xlNormal 'defaults to an ".xls" file
End If
Case "XLSB": GetFileFormat = xlExcel12
Case "XLSM": GetFileFormat = xlOpenXMLWorkbookMacroEnabled
Case "XLSX": GetFileFormat = xlOpenXMLWorkbook
Case "XLT": GetFileFormat = xlTemplate
Case "XLTM": GetFileFormat = xlOpenXMLTemplateMacroEnabled
Case "XLTX": GetFileFormat = xlOpenXMLTemplate
Case "XLW": GetFileFormat = xlExcel4Workbook
' Case "XML": GetFileFormat = xlXMLData 'Which would be the best default?
Case "XML": GetFileFormat = xlXMLSpreadsheet ' "
End Select
#If Mac Then
If CInt(Application.Version) > Excel_Mac2011_VNum Then
'This code is running on a Mac and this is Excel 2011 or a later version
'Per Ron de Bruin @http://www.rondebruin.nl/mac/mac020.htm, in Excel 2011 (Mac) you must add 1 to
'each FileFormat value. [Untested]
FileFormatCode = FileFormatCode + 1
End If
#End If
End Function