首先，如果您的意图是存储有关对象的元信息，您可以使用CustomDocumentProperties. 您可以在此处和此处找到有关其用法的示例，并在此处找到Chip Pearson 的一些不错的包装器。
由于它们的长度仍然非常有限（255 个字符）（感谢您指出这一点！），最好的解决方案可能是CustomXMLParts像这里描述的那样使用。困难的部分将是使用 VBA 构建正确的 XML，但如果您添加对Microsoft XML的引用，也许并非不可能。
但是，为了帮助您解决有关字符串属性的最大长度的问题，这里有一个测试设置，您可以使用它（相对）快速找到任意属性的这些限制。只需将第ActiveWorkbook.Sheets(1).Name19 行替换为您要测试和运行的属性TestMaxStringLengthOfProperty()：
Option Explicit
Const PRINT_STEPS = True ' If True, calculation steps will be written to Debug.Print
Private Function LengthWorks(ByVal iLengthToTest As Long) As Boolean
Dim testString As String
testString = String(iLengthToTest, "#") ' Build string with desired length
' Note: The String() method failed for different maximum string lengths possibly
' depending on available memory or other factors. You can test the current
' limit for your setup by putting the string assignment in the test space.
' In my tests I found maximum values around 1073311725 to still work.
On Error Resume Next
' ---------------------------------------------------------------------------------
' Start of the Test Space - put the method/property you want to test below here
ActiveWorkbook.Sheets(1).Name = testString
' End of the Test Space - put the method/property you want to test above here
' ---------------------------------------------------------------------------------
LengthWorks = Err.Number = 0
On Error GoTo 0
End Function
Private Sub TestMaxStringLengthOfProperty()
Const MAX_LENGTH As Long = 1000000000 ' Default: 1000000000
Const MAXIMUM_STEPS = 100 ' Exit loop after this many tries, at most
' Initialize variables for check loop
Dim currentLength As Long
Dim lowerBoundary As Long: lowerBoundary = 0
Dim upperBoundary As Long: upperBoundary = MAX_LENGTH
Dim currentStep As Long: currentStep = 0
While True ' Infinite loop, will exit sub directly
currentStep = currentStep + 1
If currentStep > MAXIMUM_STEPS Then
Debug.Print "Exiting because maximum number of steps (" & _
CStr(MAXIMUM_STEPS) & _
") was reached. Last working length was: " & _
CStr(lowerBoundary)
Exit Sub
End If
' Test the upper boundary first, if this succeeds we don't need to continue search
If LengthWorks(upperBoundary) Then
' We have a winner! :)
Debug.Print "Method/property works with the following maximum length: " & _
upperBoundary & vbCrLf & _
"(If this matches MAX_LENGTH (" & _
MAX_LENGTH & "), " & _
"consider increasing it to find the actual limit.)" & _
vbCrLf & vbCrLf & _
"Computation took " & currentStep & " steps"
Exit Sub
Else
' Upper boundary must be at least one less
upperBoundary = upperBoundary - 1
PrintStep upperBoundary + 1, "failed", lowerBoundary, upperBoundary, MAX_LENGTH
End If
' Approximately halve test length
currentLength = lowerBoundary + ((upperBoundary - lowerBoundary) \ 2)
' "\" is integer division (http://mathworld.wolfram.com/IntegerDivision.html)
' Using `left + ((right - left) \ 2)` is the default way to avoid overflows
' when calculating the midpoint for our binary search
' (see: https://en.wikipedia.org/w/index.php?title=Binary_search_algorithm&
' oldid=809435933#Implementation_issues)
If LengthWorks(currentLength) Then
' If test was successful, increase lower boundary for next step
lowerBoundary = currentLength + 1
PrintStep currentLength, "worked", lowerBoundary, upperBoundary, MAX_LENGTH
Else
' If not, set new upper boundary
upperBoundary = currentLength - 1
PrintStep currentLength, "failed", lowerBoundary, upperBoundary, MAX_LENGTH
End If
Wend
End Sub
Private Sub PrintStep(ByVal iCurrentValue As Long, _
ByVal iWorkedFailed As String, _
ByVal iNewLowerBoundary As Long, _
ByVal iNewUpperBoundary As Long, _
ByVal iMaximumTestValue As Long)
If PRINT_STEPS Then
Debug.Print Format(iCurrentValue, String(Len(CStr(iMaximumTestValue)), "0")) & _
" " & iWorkedFailed & " - New boundaries: l: " & _
iNewLowerBoundary & " u: " & iNewUpperBoundary
End If
End Sub