Ответ 1
Прежде всего, если вы намерены хранить метаинформацию об объектах, вы могли бы использовать CustomDocumentProperties
. Вы можете найти примеры использования здесь и здесь и некоторые интересные обертки от Chip Pearson здесь.
Поскольку они все еще очень ограничены (255 символов) в длину (спасибо, что указали это!), Лучшим решением может быть использование CustomXMLParts
, как описанный здесь. Тогда жесткая часть будет создавать правильный XML с помощью VBA, но, возможно, это не невозможно, если вы добавите ссылку на Microsoft XML.
Но для того, чтобы помочь вам в вопросе о максимальной длине для свойств строки, также приведена тестовая установка, которую вы можете использовать (относительно) быстро, чтобы найти эти ограничения для произвольных свойств.
Просто замените ActiveWorkbook.Sheets(1).Name
на строке 19 свойством, которое вы хотите протестировать, и запустите 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