Option Explicit
Public Sub ExportSheetOptions()
'Tools -> References: Required "Microsoft XML, v6.0"
Dim wshCur As Worksheet
Dim strPath As String
Dim shpCur As Shape
Dim strBase64 As String
Dim objXML As MSXML2.DOMDocument60
Dim objNode As MSXML2.IXMLDOMElement
Dim bytArr() As Byte
Dim bytShortArr() As Byte
Dim lngSize As Long
Dim lngTemp As Long
Set wshCur = ActiveWorkbook.ActiveSheet
strPath = ActiveWorkbook.FullName
strPath = StrReverse(Replace(StrReverse(strPath), ".", "_", 1, 1))
Set shpCur = wshCur.Shapes("FPMExcelClientSheetOptionstb1")
strBase64 = shpCur.OLEFormat.Object.Object.Text
Set objXML = New MSXML2.DOMDocument60
Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.Text = strBase64
bytArr = objNode.nodeTypedValue
Set objNode = Nothing
Set objXML = Nothing
lngSize = UBound(bytArr)
ReDim bytShortArr(0 To lngSize - 4)
For lngTemp = 4 To lngSize
bytShortArr(lngTemp - 4) = bytArr(lngTemp)
Next lngTemp
Open strPath & "_" & wshCur.Name & "_SheetOptions.gz" For Binary Access Write As #1
lngTemp = 1
Put #1, lngTemp, bytShortArr
Close #1
End Sub
Public Sub ExportWorkbookOptions()
'Tools -> References: Required "Microsoft XML, v6.0"
Dim namWorkbook As Name
Dim strPath As String
Dim shpCur As Shape
Dim strBase64 As String
Dim objXML As MSXML2.DOMDocument60
Dim objNode As MSXML2.IXMLDOMElement
Dim bytArr() As Byte
Dim bytShortArr() As Byte
Dim lngSize As Long
Dim lngTemp As Long
strPath = ActiveWorkbook.FullName
strPath = StrReverse(Replace(StrReverse(strPath), ".", "_", 1, 1))
strBase64 = ""
For Each namWorkbook In ActiveWorkbook.Names
If namWorkbook.Name Like "EPMWorkbookOptions*" Then
strBase64 = strBase64 & Mid(namWorkbook.Value, 3, Len(namWorkbook.Value) - 3)
End If
Next
Set objXML = New MSXML2.DOMDocument60
Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.Text = strBase64
bytArr = objNode.nodeTypedValue
Set objNode = Nothing
Set objXML = Nothing
lngSize = UBound(bytArr)
ReDim bytShortArr(0 To lngSize - 4)
For lngTemp = 4 To lngSize
bytShortArr(lngTemp - 4) = bytArr(lngTemp)
Next lngTemp
For lngTemp = 4 To lngSize
bytShortArr(lngTemp - 4) = bytArr(lngTemp)
Next lngTemp
Open strPath & "_WorkbookOptions.gz" For Binary Access Write As #1
lngTemp = 1
Put #1, lngTemp, bytShortArr
Close #1
End Sub
You must be a registered user to add a comment. If you've already registered, sign in. Otherwise, register and sign in.
User | Count |
---|---|
5 | |
5 | |
5 | |
5 | |
4 | |
4 | |
4 | |
4 | |
3 | |
3 |