Option Explicit
Sub createTableFromXmlCodes()
Call creatDocx(ActiveSheet, Range("C1:F5"))
End Sub
Sub createTableFromHTMCodes()
Call creatDoc(ActiveSheet, Range("C1:F5"))
End Sub
Public Function GetTable(WS As Worksheet, TblRng As Range)
Dim T As String
Dim StrHtm As String
Dim WB As Workbook: Set WB = ThisWorkbook
Dim Rng As Range, R As Range, Cell As Range, TblVisRng As Range
Dim TRA As String, TFP As String, TLP As String
Dim TBS(1 To 4) As String, BrdFC As String, BrdMFC As String
Dim TVRS(1 To 4) As Range, HorRng As Range, VarRng As Range
Dim TVRA As String, TVFP As String, TVLP As String
Dim TVRSE As String, TVRSELP As String
Dim TVRSER(1 To 2) As Range
Dim Brd(7 To 12) As Border
Dim tblGrid As String, tblBorders As String, XMsoLnStl As String
Dim I As Long, TBClr As Long, TBwt As Long, TBstl As Long, EdgClr As Long, Rngwt As Long, Rngstl As Long, Count As Long
Dim IsTblBrdrSmlr(7 To 12) As Boolean, IsMrgSdSmlr(7 To 12) As Boolean
Dim HtmTbl As String, XmlTbl As String, TblClr As String, RngClr As String, TblLnStl As String, VerMerge As String, Mrg As String, gridSpan As String, XmlBorder As String
Dim MVRA As String, MVFP As String, MVLP As String, MBS(1 To 4) As String, MPBS As String, RWCt As Variant, ClCt As Variant, rowspan As String, colspan As String, FLRw As String, outside As String, insideh As String, insidev As String
Dim Hght As Long, Wdth As Long, Ort As Long
Dim XNm As String, XB As String, XI As String, Estrk As String, XFClr As String, XSize As String, XSup As String, XSubs As String, Nm As String, FClr As String, Xu As String, Xu2 As String, XF As String, P As String, Size As Long
Dim IsMrgBrdrSmlr(7 To 10) As Boolean
Dim TextDirection As String
Dim Edg As Variant, Proper As String, E As Long, Cnt As Long, StrNum As Long, LngthNum As Long
Dim IsRngBrdrSmlr As Boolean
Dim RwNum As Long, ClNum As Long, RC As Long, CC As Long, Wt As Long, TblWt As Long
Dim Path As String, TD As String, tc As String, RwClPan As String, Brdrs As String, msoBrdrs As String, Clr As String, XClr As String, BClr As String, Strclr As String, XStrclr As String, LnStl As String, XLnStl As String, MsoLnStl As String, BckGrnd As String, XBckGrnd As String, Ornt As String
Dim prgrph As String, XMLprgrph As String, valign As String, Align As String
Dim BrdEdg As Variant
Dim HA As Long, VA As Long, LnWt As Variant
Path = WB.Path & "\"
With WS
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set TblVisRng = TblRng.SpecialCells(xlCellTypeVisible)
TRA = TblRng.Address ' Tabl Rang Address
TFP = Split(TRA, ":")(0) ' Tabl Address First Part
TLP = Split(TRA, ":")(1) ' Tabl Address Last Part
TVRA = TblVisRng.Address(False) ' Tabl Visible Rang Address $X#
TVFP = .Range(Split(Split(TVRA, ":")(0), ",")(0)).Address ' Tabl Visible Address First Part
TVLP = .Range(Split(TVRA, "$")(UBound(Split(TVRA, "$")))).Address ' Tabl Visible Address Last Part
TVRA = .Range(TVFP & ":" & TVLP).Address 'Rest Tabl Visible Rang Address with $X$#
TBS(1) = Replace(TVRA, Split(TVLP, "$")(1), Split(TVFP, "$")(1)) ' Table Border Left Side
TBS(2) = Replace(TVRA, Split(TVLP, "$")(2), Split(TVFP, "$")(2)) ' Table Border Top Side
TBS(3) = Replace(TVRA, Split(TVFP, "$")(2), Split(TVLP, "$")(2)) ' Table Border Bottom Side
TBS(4) = Replace(TVRA, Split(TVFP, "$")(1), Split(TVLP, "$")(1)) ' Table Border Right Side
Set TblVisRng = .Range(TVRA)
For I = 1 To 4
Set TVRS(I) = .Range(TBS(I)).SpecialCells(xlCellTypeVisible)
Next
' check out out Borders is similar
For I = 1 To 4
For Each R In TVRS(I)
BrdFC = Split(Split(TBS(I), ":")(0), ",")(0)
With R
Set Brd(I + 6) = .Borders(I + 6)
If .Address = BrdFC Or (Brd(I + 6).LineStyle <> xlNone And Brd(I + 6).Color = TBClr And Brd(I + 6).Weight = TBwt And Brd(I + 6).LineStyle = TBstl) Then
IsTblBrdrSmlr(I + 6) = True
Else
IsTblBrdrSmlr(I + 6) = False: Exit For
End If
TBClr = Brd(I + 6).Color: TBwt = Brd(I + 6).Weight: TBstl = Brd(I + 6).LineStyle
End With
Next
Next
' check out Hor Borders is similar
Count = 0
IsTblBrdrSmlr(12) = True
For Each R In TVRS(1)
Set HorRng = .Range(Replace(TVRS(2).Address, Split(Split(Split(TBS(2), ":")(0), ",")(0), "$")(2), Split(R.Address, "$")(2)))
For Each Cell In HorRng
Count = Count + 1
With Cell
If .Row > Range(TFP).Row Then
Set Brd(8) = .Borders(xlEdgeTop)
If Count = 1 Or (Brd(8).LineStyle <> xlNone And Brd(8).Color = TBClr And Brd(8).Weight = TBwt And Brd(8).LineStyle = TBstl) Then
IsTblBrdrSmlr(12) = True
Else
IsTblBrdrSmlr(12) = False: Exit For
End If
TBClr = Brd(8).Color: TBwt = Brd(8).Weight: TBstl = Brd(8).LineStyle
End If
End With
Next
If IsTblBrdrSmlr(12) = False Then Exit For
Next
'_______________________________
' check out Var Borders is similar
IsTblBrdrSmlr(11) = True
Count = 0
For Each R In TVRS(2)
Set VarRng = .Range(Replace(TVRS(1).Address, Split(Split(Split(TBS(1), ":")(0), ",")(0), "$")(1), Split(R.Address, "$")(1)))
For Each Cell In VarRng
With Cell
If .Column > Range(TFP).Column Then
Set Brd(7) = .Borders(xlEdgeLeft)
Count = Count + 1
If Count = 1 Or (Brd(7).LineStyle <> xlNone And Brd(7).Color = TBClr And Brd(7).Weight = TBwt And Brd(7).LineStyle = TBstl) Then
IsTblBrdrSmlr(11) = True
Else
IsTblBrdrSmlr(11) = False: Exit For
End If
TBClr = Brd(7).Color: TBwt = Brd(7).Weight: TBstl = Brd(7).LineStyle
End If
End With
Next
If IsTblBrdrSmlr(11) = False Then Exit For
Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If IsTblBrdrSmlr(7) = True And IsTblBrdrSmlr(8) = True And IsTblBrdrSmlr(9) = True And IsTblBrdrSmlr(10) = True Then
With .Range(TVRA).Borders(xlEdgeLeft)
Strclr = Right("000000" & Hex(.Color), 6)
TblClr = Right(Strclr, 2) & Mid(Strclr, 3, 2) & Left(Strclr, 2)
TblLnStl = IIf(.LineStyle = 1, "solid", IIf(.LineStyle = 4, "dot-Dash", IIf(.LineStyle = 5, "dot-Dot-Dash", IIf(.LineStyle = 13, "dash-Dot-Stroked", IIf(.LineStyle = -4115, "Dash", IIf(.LineStyle = -4118, "Dot", IIf(.LineStyle = -4119, "Double", "")))))))
outside = ";border:none;mso-border-alt:" & TblLnStl & " #" & TblClr & " " & Brd(7).Weight & "pt"
End With
End If
If IsTblBrdrSmlr(11) = True Then
With TVRS(1).Borders(xlEdgeRight)
Strclr = Right("000000" & Hex(.Color), 6)
TblClr = Right(Strclr, 2) & Mid(Strclr, 3, 2) & Left(Strclr, 2)
TblLnStl = IIf(.LineStyle = 1, "solid", IIf(.LineStyle = 4, "dot-Dash", IIf(.LineStyle = 5, "dot-Dot-Dash", IIf(.LineStyle = 13, "dash-Dot-Stroked", IIf(.LineStyle = -4115, "Dash", IIf(.LineStyle = -4118, "Dot", IIf(.LineStyle = -4119, "Double", "")))))))
End With
insidev = ";mso-border-insidev:" & Brd(10).Weight & "pt " & TblLnStl & " #" & TblClr
End If
If IsTblBrdrSmlr(12) = True Then
With TVRS(2).Borders(xlEdgeBottom)
Strclr = Right("000000" & Hex(.Color), 6)
TblClr = Right(Strclr, 2) & Mid(Strclr, 3, 2) & Left(Strclr, 2)
TblLnStl = IIf(.LineStyle = 1, "solid", IIf(.LineStyle = 4, "dot-Dash", IIf(.LineStyle = 5, "dot-Dot-Dash", IIf(.LineStyle = 13, "dash-Dot-Stroked", IIf(.LineStyle = -4115, "Dash", IIf(.LineStyle = -4118, "Dot", IIf(.LineStyle = -4119, "Double", "")))))))
End With
insideh = ";mso-border-insideh:" & Brd(9).Weight & "pt " & TblLnStl & " #" & TblClr
End If
For I = 7 To 12
IsTblBrdrSmlr(I) = True
Next
'just now start make Table
BrdEdg = Split("left,top,bottom,right,insideV,insideH", ",")
StrHtm = "< html xmlns:v=""urn:schemas-microsoft-com:vml""" & vbNewLine & _
" xmlns:o=""urn:schemas-microsoft-com:office:office""" & vbNewLine & _
" xmlns:w=""urn:schemas-microsoft-com:office:word""" & vbNewLine & _
" xmlns:m=""http://schemas.microsoft.com/office/2004/12/omml""" & vbNewLine & _
" xmlns=""http://www.w3.org/TR/REC-html40"">" & vbNewLine
StrHtm = StrHtm & "< head>" & vbNewLine & _
" < meta http-equiv=Content-Type content=""text/html; charset=windows-1252"">" & vbNewLine & _
" < meta name=ProgId content=Word.Document>" & vbNewLine & _
" < meta name=Generator content=""Microsoft Word 15"">" & vbNewLine & _
" < meta name=Originator content=""Microsoft Word 15"">" & vbNewLine & _
" < link rel=File-List href=""Doc1.files/filelist.xml"">" & vbNewLine
StrHtm = StrHtm & "< link rel=themeData href=""Doc1.files/themedata.thmx"">" & vbNewLine & _
"< link rel=colorSchemeMapping href=""Doc1.files/colorschememapping.xml"">" & vbNewLine
StrHtm = StrHtm & "< style>" & vbNewLine & "< !--" & vbNewLine & " /* Font Definitions */" & vbNewLine & " @font-face" & vbNewLine & " {font-family:""Cambria Math"";" & vbNewLine & " panose-1:2 4 5 3 5 4 6 3 2 4;" & vbNewLine & " mso-font-charset:0;" & vbNewLine & " mso-generic-font-family:roman;" & vbNewLine & " mso-font-pitch:variable;" & vbNewLine & " mso-font-signature:3 0 0 0 1 0;}" & vbNewLine
StrHtm = StrHtm & " /* Style Definitions */" & vbNewLine & " p.MsoNormal, li.MsoNormal, div.MsoNormal" & vbNewLine & " {mso-style-unhide:no;" & vbNewLine & " mso-style-qformat:yes;" & vbNewLine & " mso-style-parent:"""";" & vbNewLine & " margin:0in;" & vbNewLine & " margin-bottom:.0001pt;" & vbNewLine & " mso-pagination:widow-orphan;" & vbNewLine & " font-size:12.0pt;" & vbNewLine & " font-family:""Times New Roman"",serif;" & vbNewLine & " mso-fareast-font-family:""Times New Roman"";" & vbNewLine & " mso-fareast-theme-font:minor-fareast;}" & vbNewLine
StrHtm = StrHtm & "p.msonormal0, li.msonormal0, div.msonormal0" & vbNewLine & " {mso-style-name:msonormal;" & vbNewLine & " mso-style-unhide:no;" & vbNewLine & " mso-margin-top-alt:auto;" & vbNewLine & " margin-right:0in;" & vbNewLine & " mso-margin-bottom-alt:auto;" & vbNewLine & " margin-left:0in;" & vbNewLine & " mso-pagination:widow-orphan;" & vbNewLine & " font-size:12.0pt;" & vbNewLine & " font-family:""Times New Roman"",serif;" & vbNewLine & " mso-fareast-font-family:""Times New Roman"";" & vbNewLine & " mso-fareast-theme-font:minor-fareast;}" & vbNewLine
StrHtm = StrHtm & ".MsoChpDefault" & vbNewLine & " {mso-style-type:export-only;" & vbNewLine & " mso-default-props:yes;" & vbNewLine & " font-size:10.0pt;" & vbNewLine & " mso-ansi-font-size:10.0pt;" & vbNewLine & " mso-bidi-font-size:10.0pt;}" & vbNewLine
StrHtm = StrHtm & "@page WordSection1" & vbNewLine & " {size:8.5in 11.0in;" & vbNewLine & " margin:1.0in 1.0in 1.0in 1.0in;" & vbNewLine & " mso-header-margin:.5in;" & vbNewLine & " mso-footer-margin:.5in;" & vbNewLine & " mso-paper-source:0;}" & vbNewLine
StrHtm = StrHtm & "div.WordSection1" & vbNewLine & " {page:WordSection1;}" & vbNewLine & "-->" & vbNewLine & "< /style>" & vbNewLine & "< /head>" & vbNewLine
'Table
HtmTbl = StrHtm & HtmTbl & "< body lang=EN-US style='tab-interval:.5in'>" & vbNewLine & "< div class=WordSection1 dir=RTL>" & vbNewLine & "< div align=left dir=ltr>" & vbNewLine & _
"< table class=MsoTableGrid border=1 cellspacing=0 cellpadding=0 style='border-collapse:collapse" & outside & "; mso-yfti-tbllook:1184;mso-padding-alt:0in 5.4pt 0in 5.4pt" & insideh & insidev & "'>" & vbNewLine
XmlTbl = "< ?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" & vbNewLine
XmlTbl = XmlTbl & "< w:document xmlns:wpc=""http://schemas.microsoft.com/office/word/2010/wordprocessingCanvas"" xmlns:cx=""http://schemas.microsoft.com/office/drawing/2014/chartex""" & _
" xmlns:cx1=""http://schemas.microsoft.com/office/drawing/2015/9/8/chartex"" xmlns:cx2=""http://schemas.microsoft.com/office/drawing/2015/10/21/chartex""" & _
" xmlns:cx3=""http://schemas.microsoft.com/office/drawing/2016/5/9/chartex"" xmlns:cx4=""http://schemas.microsoft.com/office/drawing/2016/5/10/chartex""" & _
" xmlns:cx5=""http://schemas.microsoft.com/office/drawing/2016/5/11/chartex"" xmlns:cx6=""http://schemas.microsoft.com/office/drawing/2016/5/12/chartex""" & _
" xmlns:cx7=""http://schemas.microsoft.com/office/drawing/2016/5/13/chartex"" xmlns:cx8=""http://schemas.microsoft.com/office/drawing/2016/5/14/chartex""" & _
" xmlns:mc=""http://schemas.openxmlformats.org/markup-compatibility/2006"" xmlns:aink=""http://schemas.microsoft.com/office/drawing/2016/ink""" & _
" xmlns:am3d=""http://schemas.microsoft.com/office/drawing/2017/model3d"" xmlns:o=""urn:schemas-microsoft-com:office:office""" & _
" xmlns:r=""http://schemas.openxmlformats.org/officeDocument/2006/relationships"" xmlns:m=""http://schemas.openxmlformats.org/officeDocument/2006/math"" xmlns:v=""urn:schemas-microsoft-com:vml""" & _
" xmlns:wp14=""http://schemas.microsoft.com/office/word/2010/wordprocessingDrawing"" xmlns:wp=""http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing""" & _
" xmlns:w10=""urn:schemas-microsoft-com:office:word"" xmlns:w=""http://schemas.openxmlformats.org/wordprocessingml/2006/main""" & _
" xmlns:w14=""http://schemas.microsoft.com/office/word/2010/wordml"" xmlns:w15=""http://schemas.microsoft.com/office/word/2012/wordml""" & _
" xmlns:w16cid=""http://schemas.microsoft.com/office/word/2016/wordml/cid"" xmlns:w16se=""http://schemas.microsoft.com/office/word/2015/wordml/symex""" & _
" xmlns:wpg=""http://schemas.microsoft.com/office/word/2010/wordprocessingGroup"" xmlns:wpi=""http://schemas.microsoft.com/office/word/2010/wordprocessingInk""" & _
" xmlns:wne=""http://schemas.microsoft.com/office/word/2006/wordml"" xmlns:wps=""http://schemas.microsoft.com/office/word/2010/wordprocessingShape"" mc:Ignorable=""w14 w15 w16se w16cid wp14"">" & vbNewLine
XmlTbl = XmlTbl & "< w:body>" & vbNewLine
tblBorders = "< w:tblBorders>" & vbNewLine
For I = 7 To 12
With TblVisRng
With .Borders(I)
Strclr = Right("000000" & Hex(.Color), 6)
Clr = Right(Strclr, 2) & Mid(Strclr, 3, 2) & Left(Strclr, 2)
LnStl = IIf(.LineStyle = 1, "solid", IIf(.LineStyle = 4, "dot-Dash", IIf(.LineStyle = 5, "dot-Dot-Dash", IIf(.LineStyle = 13, "dash-Dot-Stroked", IIf(.LineStyle = -4115, "dashed", IIf(.LineStyle = -4118, "dotted", IIf(.LineStyle = -4119, "Double", "")))))))
XMsoLnStl = Replace(Trim(Replace(LnStl, "solid", "single")), "-", "")
Wt = IIf(.Weight > 0, .Weight, .Weight + 4141)
tblBorders = tblBorders & "< w:" & BrdEdg(I - 7) & " w:val=""" & XMsoLnStl & """ w:color=""" & Clr & """ w:space=""0"" w:sz=""" & Wt * 6 & """/>" & vbNewLine
End With
End With
Next
tblBorders = tblBorders & "< /w:tblBorders>"
tblGrid = "< w:tblGrid>" & vbNewLine 'compute Columns Width
For Each Rng In TVRS(2)
tblGrid = tblGrid & "< w:gridCol w:w=""" & Rng.Width * 20 & """/>" & vbNewLine
Next
tblGrid = tblGrid & "< /w:tblGrid>" & vbNewLine
XmlTbl = XmlTbl & "< w:tbl>" & vbNewLine & "< w:tblPr>" & vbNewLine & _
"< w:tblStyle w:val=""a3""/>" & vbNewLine & _
"< w:tblW w:w=""0"" w:type=""auto""/>" & vbNewLine & _
"< w:tblCellMar>" & vbNewLine & _
"< w:left w:w=""29"" w:type=""dxa""/>" & vbNewLine & _
"< w:right w:w=""29"" w:type=""dxa""/>" & vbNewLine & _
"< /w:tblCellMar>" & vbNewLine & _
tblBorders & _
"< w:shd w:val=""clear"" w:color=""auto"" w:fill=""FFFF00""/>" & vbNewLine & _
"< w:tblLayout w:type=""fixed""/>" & vbNewLine & _
"< w:tblLook w:val=""04A0"" w:noVBand=""1"" w:noHBand=""0"" w:lastColumn=""0"" w:firstColumn=""1"" w:lastRow=""0"" w:firstRow=""1""/>" & vbNewLine & _
"< /w:tblPr>" & vbNewLine & _
tblGrid
For Each Rng In .Range(TVRA)
Brdrs = "": msoBrdrs = ""
LnStl = "": Clr = ""
Wt = 0
With Rng
If .EntireColumn.Hidden = False And .EntireRow.Hidden = False Then
RwNum = .Row - Range(TVFP).Row
ClNum = .Column - Range(TVFP).Column
Hght = .Height
If .Row = Range(TVFP).Row Then
FLRw = ";mso-yfti-firstrow:yes" 'First Row
ElseIf .Row = Range(TVLP).Row Then
FLRw = ";mso-yfti-lastrow:yes" 'Last Row
Else
FLRw = ""
End If
If .Column = Range(TVFP).Column Then ' start row HTML & Xml
HtmTbl = HtmTbl & "< tr style='mso-yfti-irow:" & .Row - Range(TVFP).Row & FLRw & ";height:" & Hght & "pt" & "'>" & vbNewLine
XmlTbl = XmlTbl & "< w:tr w:rsidTr=""00226D8D"" w:rsidRPr=""00FB0C23"" w:rsidR=""00FB0C23"">" & vbNewLine & "< w:trPr>" & vbNewLine & "< w:trHeight w:val=""" & Hght * 20 & """/>" & vbNewLine & "< /w:trPr>" & vbNewLine
End If
T = ""
gridSpan = ""
'============================================================================
' Merge Cells
'============================================================================
If .MergeCells = True Then
Wdth = .MergeArea.Width
MVRA = .MergeArea.SpecialCells(xlCellTypeVisible).Address(False) ' Merge Visible Rang Address $X#
MVFP = Range(Split(Split(MVRA, ":")(0), ",")(0)).Address ' Merge Visible Address First Part
MVLP = Range(Split(MVRA, "$")(UBound(Split(MVRA, "$")))).Address ' Merge Visible Address Last Part
MVRA = WS.Range(MVFP & ":" & MVLP).Address 'Rest Tabl Visible Rang Address with $X$#
MBS(1) = Replace(MVRA, Split(MVLP, "$")(1), Split(MVFP, "$")(1)) ' Table Border Left Side
MBS(2) = Replace(MVRA, Split(MVLP, "$")(2), Split(MVFP, "$")(2)) ' Table Border Top Side
MBS(3) = Replace(MVRA, Split(MVFP, "$")(2), Split(MVLP, "$")(2)) ' Table Border Bottom Side
MBS(4) = Replace(MVRA, Split(MVFP, "$")(1), Split(MVLP, "$")(1)) ' Table Border Right Side
MPBS = Replace(MBS(2), Split(Split(MBS(2), ":")(0), "$")(2), Split(.Address, "$")(2))
For I = 1 To 4
For Each R In WS.Range(MBS(I)).SpecialCells(xlCellTypeVisible)
BrdMFC = Split(Split(MBS(I), ":")(0), ",")(0)
With R
Set Brd(I + 6) = .Borders(I + 6)
If .Address = BrdMFC Or (Brd(I + 6).LineStyle <> xlNone And Brd(I + 6).Color = TBClr And Brd(I + 6).Weight = TBwt And Brd(I + 6).LineStyle = TBstl) Then
IsMrgBrdrSmlr(I + 6) = True
Else
IsMrgBrdrSmlr(I + 6) = False: Exit For
End If
TBClr = Brd(I + 6).Color: TBwt = Brd(I + 6).Weight: TBstl = Brd(I + 6).LineStyle
End With
Next
Next
'Count Merge Cells Rows & Column
If .Parent.Range(MBS(1)).Address <> MVFP Then
RWCt = Split(.Parent.Range(MBS(1)).SpecialCells(xlCellTypeVisible).Address, ",")
Else
RWCt = Split(MVFP, ",")
End If
If .Parent.Range(MBS(2)).Address <> MVFP Then
ClCt = Split(.Parent.Range(MBS(2)).SpecialCells(xlCellTypeVisible).Address, ",")
Else
ClCt = Split(MVLP, ",")
End If
RC = 0
For I = 0 To UBound(RWCt)
RC = RC + WS.Range(RWCt(I)).Rows.Count
Next
CC = 0
For I = 0 To UBound(ClCt)
CC = CC + WS.Range(ClCt(I)).Columns.Count
Next
'============================================================================
' Start from Here Merge Cells First Cell of Merge
'============================================================================
If .Address = MVFP Then 'First Cell of Merge
rowspan = "": colspan = ""
If RC > 1 Then rowspan = " rowspan=" & RC
If CC > 1 Then colspan = " colspan=" & CC
RwClPan = rowspan & colspan
Mrg = ""
If RC > 1 Then Mrg = " w:val=""restart"""
If RC > 1 Then VerMerge = "< w:vMerge" & Mrg & "/>"
gridSpan = "< w:gridSpan w:val=""" & CC & """/>" & VerMerge
XmlBorder = "< w:tcBorders>" & vbNewLine
For I = 1 To 4
With .MergeArea.Borders(I + 6)
Strclr = Right("000000" & Hex(.Color), 6)
Clr = Right(Strclr, 2) & Mid(Strclr, 3, 2) & Left(Strclr, 2)
LnStl = IIf(.LineStyle = 1, "solid", IIf(.LineStyle = 4, "dot-Dash", IIf(.LineStyle = 5, "dot-Dot-Dash", IIf(.LineStyle = 13, "dash-Dot-Stroked", IIf(.LineStyle = -4115, "dashed", IIf(.LineStyle = -4118, "dotted", IIf(.LineStyle = -4119, "Double", "")))))))
MsoLnStl = IIf(.LineStyle = 1, "solid", IIf(.LineStyle = 4, "dot-Dash", IIf(.LineStyle = 5, "dot-Dot-Dash", IIf(.LineStyle = 13, "dash-Dot-Stroked", IIf(.LineStyle = -4115, "Dash", IIf(.LineStyle = -4118, "dotted", IIf(.LineStyle = -4119, "Double", "")))))))
Wt = IIf(.Weight = -4138, 3, .Weight) / 1.5
'Wt = Wt * (Wt * 0.25) dashDotStroked
End With
With .Parent.Range(MPBS).Borders(I + 6)
XStrclr = Right("000000" & Hex(.Color), 6)
XClr = Right(Strclr, 2) & Mid(Strclr, 3, 2) & Left(Strclr, 2)
XLnStl = IIf(.LineStyle = 1, "solid", IIf(.LineStyle = 4, "dot-Dash", IIf(.LineStyle = 5, "dot-Dot-Dash", IIf(.LineStyle = 13, "dash-Dot-Stroked", IIf(.LineStyle = -4115, "dashed", IIf(.LineStyle = -4118, "dotted", IIf(.LineStyle = -4119, "Double", "")))))))
XMsoLnStl = Replace(Trim(Replace(XLnStl, "solid", "single")), "-", "")
End With
If InStr(1, LnStl, "Dash", vbTextCompare) Then LnStl = Replace(LnStl, LnStl, "dashed")
Count = 0
For Each R In .Parent.Range(MBS(I))
With R
Set Brd(I + 6) = .Borders(I + 6)
If .Address = MVFP Or (Brd(I + 6).LineStyle <> xlNone And Brd(I + 6).Color = TBClr And Brd(I + 6).Weight = TBwt And Brd(I + 6).LineStyle = TBstl) Then
IsMrgSdSmlr(I + 6) = True
Else
IsMrgSdSmlr(I + 6) = False: Exit For
End If
TBClr = Brd(I + 6).Color: TBwt = Brd(I + 6).Weight: TBstl = Brd(I + 6).LineStyle
End With
Next
Proper = LnStl & " #" & Clr & " " & Wt & "pt"
If IsMrgSdSmlr(I + 6) = True And Brd(I + 6).LineStyle <> xlNone Then
If (RwNum <> 0 And I = 2) Or (ClNum <> 0 And I = 1) Then
Brdrs = Brdrs & ";border-" & BrdEdg(I - 1) & ":none"
msoBrdrs = msoBrdrs & ";mso-border-" & BrdEdg(I - 1) & "-alt:" & MsoLnStl & " #" & Clr & " " & Wt & "pt"
If LnStl = "solid" Or LnStl = "dotted" Then
msoBrdrs = msoBrdrs & ";mso-border-" & BrdEdg(I - 1) & "-alt:" & MsoLnStl & " #" & Clr & " " & Wt & "pt"
Else
msoBrdrs = msoBrdrs & ";mso-border-" & BrdEdg(I - 1) & "-alt:" & MsoLnStl & " #" & Clr & " " & Wt & "pt"
End If
XmlBorder = XmlBorder & "< w:" & BrdEdg(I - 1) & " w:val=""nil""/>" & vbNewLine
Else
If Brdrs <> "" And InStr(Brdrs, Proper) <> 0 And (InStr(Brdrs, "border:") = 0 Or InStr(Brdrs, "border:" & Proper) <> 0) Then
Edg = Split(Brdrs, ";")
For E = LBound(Edg) To UBound(Edg)
Cnt = Cnt + LBound(Edg)
If Edg(E) <> "" And InStr(Edg(E), Proper) <> 0 Then
StrNum = InStr(Edg(E), "border") + Len("border") + Cnt
LngthNum = (Cnt + Len(Edg(E))) - (Len(Proper) + StrNum)
Brdrs = Replace(Brdrs, Mid(Edg(E), StrNum, LngthNum), "")
Else
End If
Next
Else
Brdrs = ";border-" & BrdEdg(I - 1) & ":" & Proper & Brdrs
End If
msoBrdrs = msoBrdrs & ";mso-border-" & BrdEdg(I - 1) & "-alt:" & MsoLnStl & " #" & Clr & " " & Wt & "pt"
XmlBorder = XmlBorder & "< w:" & BrdEdg(I - 1) & " w:val=""" & XMsoLnStl & """ w:color=""" & XClr & """ w:space=""" & 0 & """ w:sz=""" & Wt * 6 & """/>" & vbNewLine
End If
Else
Brdrs = Brdrs & ";border-" & BrdEdg(I - 1) & ":none"
XmlBorder = XmlBorder & "< w:" & BrdEdg(I - 1) & " w:val=""nil""/>" & vbNewLine
End If
Next
XmlBorder = XmlBorder & "< /w:tcBorders>" '''
Brdrs = Brdrs & msoBrdrs
Brdrs = Brdrs & msoBrdrs
Strclr = Right("000000" & Hex(.Interior.Color), 6)
BClr = Right(Strclr, 2) & Mid(Strclr, 3, 2) & Left(Strclr, 2)
BckGrnd = IIf(.Interior.Pattern <> xlNone, ";background:#" & BClr, "")
XBckGrnd = ""
XBckGrnd = IIf(.Interior.Pattern <> xlNone, " w:fill=""" & BClr & """", "")
Ort = IIf(.Orientation = -4128, 0, IIf(.Orientation = -4171, 90, -90)) 'Orientation 0=-4128, 90=-4171, -90=-4170
Ornt = IIf(Ort = 0, "", IIf(Ort = 90, ";mso-rotate:" & 90, ";mso-rotate:" & -90))
HA = .HorizontalAlignment 'xlleft=-4131, xlcenter=-4108, xlright=-4152
VA = .VerticalAlignment 'xltop=-4160, xlcenter=-4108, xlbottom=-4107
valign = IIf(VA = xlTop, "top", IIf(VA = xlCenter, "center", "bottom"))
valign = IIf(Ort = 0, valign, IIf(Ort = 90, IIf(HA = xlLeft, "top", IIf(HA = xlRight, "bottom", "center")), IIf(HA = xlLeft, "bottom", IIf(HA = xlRight, "top", "center"))))
Align = IIf(HA = -4131, "left", IIf(HA = -4108, "center", "right"))
Align = IIf(Ort = 0, Align, IIf(Ort = 90, IIf(VA = xlTop, "right", IIf(VA = xlBottom, "left", "center")), IIf(VA = xlTop, "left", IIf(VA = xlBottom, "right", "center"))))
prgrph = Split(TextFormat(.MergeArea.Cells(1, 1)), "|")(0)
XMLprgrph = Split(TextFormat(.MergeArea.Cells(1, 1)), "|")(1)
TD = "width=" & Wdth & RwClPan & " valign=" & valign & " style='width:" & Wdth * 1 & "pt" & Brdrs & BckGrnd & ";padding:0in 0in 0in 0in" & Ornt & ";height:" & Hght & "pt'"
With .MergeArea.Font
XNm = "": XB = "": XI = "": Estrk = "": XFClr = "": XSize = "": XSup = "": XSubs = ""
Nm = .Name: Size = .Size
XNm = "< w:rFonts w:ascii=""" & Nm & """ w:hAnsi=""" & Nm & """ w:cs=""" & Nm & """/>"
XSize = "< w:sz w:val=""" & Size * 2 & """/>< w:szCs w:val=""" & Size * 2 & """/>"
Strclr = Right("000000" & Hex(.Color), 6)
FClr = Right(Strclr, 2) & Mid(Strclr, 3, 2) & Left(Strclr, 2)
XFClr = "< w:color w:val=""" & FClr & """/>"
If .Bold = True Then XB = "< w:b/>" & vbNewLine & "< w:bCs/>" & vbNewLine
If .Italic = True Then XI = "< w:i/>" & vbNewLine & "< w:iCs/>" & vbNewLine
If .Underline = 2 Then Xu = "< w:u w:val=""single""/>" & vbNewLine
If .Underline = -4119 Then Xu2 = "< w:u w:val=""double""/>" & vbNewLine
If .Strikethrough = True Then Estrk = "< /strike>" & vbNewLine
If .Superscript = True Then XSup = "< w:vertAlign w:val=""superscript""/>" & vbNewLine
If .Subscript = True Then XSubs = "< w:vertAlign w:val=""Subscript""/>" & vbNewLine
XF = XNm & XB & XI & Estrk & XFClr & XSize & XSup & XSubs
End With
P = "< w:p w:rsidR=""00B527A5"" w:rsidRDefault=""00B527A5"">" & vbNewLine & _
"< w:pPr>" & vbNewLine & _
"< w:bidi w:val=""0""/>" & vbNewLine & _
"< w:spacing w:after=""0""/>" & vbNewLine & _
"< w:jc w:val=""" & Align & """/>" & vbNewLine & _
"< w:rPr>" & vbNewLine & _
XF & vbNewLine & _
"< /w:rPr>" & vbNewLine & _
"< /w:pPr>" & vbNewLine & _
XMLprgrph & vbNewLine & _
"< /w:p>"
TextDirection = IIf(Ort = 90, "< w:textDirection w:val=""btLr""/>", IIf(Ort = -90, "< w:textDirection w:val=""tbRl""/>", ""))
tc = ""
tc = "< w:tc>" & vbNewLine & _
"< w:tcPr>" & vbNewLine & _
"< w:tcW w:w=""" & Wdth * 20 & """ w:type=""dxa""/>" & _
gridSpan & vbNewLine & _
XmlBorder & _
"< w:shd w:val=""" & "Clear" & """ w:color=""auto""" & XBckGrnd & "/>" & vbNewLine & _
TextDirection & _
"< w:vAlign w:val=""" & LCase(valign) & """/>" & vbNewLine & _
"< w:hideMark/>" & vbNewLine & _
"< /w:tcPr>" & vbNewLine & _
P & _
"< /w:tc>"
HtmTbl = HtmTbl & " < td " & TD & ">" & prgrph & "< /td>" & vbNewLine
XmlTbl = XmlTbl & tc
ElseIf .Column = WS.Range(MVFP).Column Then 'First Cell of first column of Merge
'============================================================================
' only For XML Merge Cells First Column of Merge next First Cell of Merg
'============================================================================
rowspan = "": colspan = ""
If RC > 1 Then rowspan = " rowspan=" & RC
If CC > 1 Then colspan = " colspan=" & CC
RwClPan = rowspan & colspan
gridSpan = "< w:gridSpan w:val=""" & CC & """/>" & "< w:vMerge" & "/>"
XmlBorder = "< w:tcBorders>" & vbNewLine
For I = 1 To 4
With .Parent.Range(MPBS).Borders(I + 6)
Strclr = Right("000000" & Hex(.Color), 6)
Clr = Right(Strclr, 2) & Mid(Strclr, 3, 2) & Left(Strclr, 2)
LnStl = IIf(.LineStyle = 1, "solid", IIf(.LineStyle = 4, "dot-Dash", IIf(.LineStyle = 5, "dot-Dot-Dash", IIf(.LineStyle = 13, "dash-Dot-Stroked", IIf(.LineStyle = -4115, "dashed", IIf(.LineStyle = -4118, "dotted", IIf(.LineStyle = -4119, "Double", "")))))))
MsoLnStl = IIf(.LineStyle = 1, "solid", IIf(.LineStyle = 4, "dot-Dash", IIf(.LineStyle = 5, "dot-Dot-Dash", IIf(.LineStyle = 13, "dash-Dot-Stroked", IIf(.LineStyle = -4115, "Dash", IIf(.LineStyle = -4118, "dotted", IIf(.LineStyle = -4119, "Double", "")))))))
XMsoLnStl = Replace(Trim(Replace(LnStl, "solid", "single")), "-", "")
Wt = IIf(.Weight = -4138, 3, .Weight) / 1.5
'Wt = Wt * (Wt * 0.25)
If (RwNum <> 0 And I = 2) Or (ClNum <> 0 And I = 1) Then
XmlBorder = XmlBorder & "< w:" & BrdEdg(I - 1) & " w:val=""nil""/>" & vbNewLine
Else
If .LineStyle <> xlNone Then
XmlBorder = XmlBorder & "< w:" & BrdEdg(I - 1) & " w:val=""" & XMsoLnStl & """ w:color=""" & Clr & """ w:space=""" & 0 & """ w:sz=""" & Wt * 6 & """/>" & vbNewLine
Else
XmlBorder = XmlBorder & "< w:" & BrdEdg(I - 1) & " w:val=""nil""/>" & vbNewLine
End If
End If
End With
Next
XmlBorder = XmlBorder & "< /w:tcBorders>" '''
Strclr = Right("000000" & Hex(.Interior.Color), 6)
BClr = Right(Strclr, 2) & Mid(Strclr, 3, 2) & Left(Strclr, 2)
XBckGrnd = ""
XBckGrnd = IIf(.Interior.Pattern <> xlNone, " w:fill=""" & BClr & """", "")
Ort = IIf(.Orientation = -4128, 0, IIf(.Orientation = -4171, 90, -90)) 'Orientation 0=-4128, 90=-4171, -90=-4170
Ornt = IIf(Ort = 0, "", IIf(Ort = 90, ";mso-rotate:" & 90, ";mso-rotate:" & -90))
HA = .HorizontalAlignment 'xlleft=-4131, xlcenter=-4108, xlright=-4152
VA = .VerticalAlignment 'xltop=-4160, xlcenter=-4108, xlbottom=-4107
valign = IIf(VA = xlTop, "top", IIf(VA = xlCenter, "center", "bottom"))
valign = IIf(Ort = 0, valign, IIf(Ort = 90, IIf(HA = xlLeft, "top", IIf(HA = xlRight, "bottom", "center")), IIf(HA = xlLeft, "bottom", IIf(HA = xlRight, "top", "center"))))
Align = IIf(HA = -4131, "left", IIf(HA = -4108, "center", "right"))
Align = IIf(Ort = 0, Align, IIf(Ort = 90, IIf(VA = xlTop, "right", IIf(VA = xlBottom, "left", "center")), IIf(VA = xlTop, "left", IIf(VA = xlBottom, "right", "center"))))
XMLprgrph = Split(TextFormat(.Cells(1, 1)), "|")(1)
With .Cells(1, 1).Font
XNm = "": XB = "": XI = "": Estrk = "": XFClr = "": XSize = "": XSup = "": XSubs = ""
Nm = .Name: Size = .Size
XNm = "< w:rFonts w:ascii=""" & Nm & """ w:hAnsi=""" & Nm & """ w:cs=""" & Nm & """/>"
XSize = "< w:sz w:val=""" & Size * 2 & """/>< w:szCs w:val=""" & Size * 2 & """/>"
Strclr = Right("000000" & Hex(.Color), 6)
FClr = Right(Strclr, 2) & Mid(Strclr, 3, 2) & Left(Strclr, 2)
XFClr = "< w:color w:val=""" & FClr & """/>"
If .Bold = True Then XB = "< w:b/>" & vbNewLine & "< w:bCs/>" & vbNewLine
If .Italic = True Then XI = "< w:i/>" & vbNewLine & "< w:iCs/>" & vbNewLine
If .Underline = 2 Then Xu = "< w:u w:val=""single""/>" & vbNewLine
If .Underline = -4119 Then Xu2 = "< w:u w:val=""double""/>" & vbNewLine
If .Strikethrough = True Then Estrk = "< /strike>" & vbNewLine
If .Superscript = True Then XSup = "< w:vertAlign w:val=""superscript""/>" & vbNewLine
If .Subscript = True Then XSubs = "< w:vertAlign w:val=""Subscript""/>" & vbNewLine
XF = XNm & XB & XI & Estrk & XFClr & XSize & XSup & XSubs
End With
P = "< w:p w:rsidR=""00B527A5"" w:rsidRDefault=""00B527A5"">" & vbNewLine & _
"< w:pPr>" & vbNewLine & _
"< w:bidi w:val=""0""/>" & vbNewLine & _
"< w:spacing w:after=""0""/>" & vbNewLine & _
"< w:jc w:val=""" & Align & """/>" & vbNewLine & _
"< w:rPr>" & vbNewLine & _
XF & vbNewLine & _
"< /w:rPr>" & vbNewLine & _
"< /w:pPr>" & vbNewLine & _
XMLprgrph & vbNewLine & _
"< /w:p>"
TextDirection = IIf(Ort = 90, "< w:textDirection w:val=""btLr""/>", IIf(Ort = -90, "< w:textDirection w:val=""tbRl""/>", ""))
tc = ""
tc = "< w:tc>" & vbNewLine & _
"< w:tcPr>" & vbNewLine & _
"< w:tcW w:w=""" & Wdth * 20 & """ w:type=""dxa""/>" & _
gridSpan & vbNewLine & _
XmlBorder & _
"< w:shd w:val=""" & "Clear" & """ w:color=""auto""" & XBckGrnd & "/>" & vbNewLine & _
TextDirection & _
"< w:vAlign w:val=""" & LCase(valign) & """/>" & vbNewLine & _
"< w:hideMark/>" & vbNewLine & _
"< /w:tcPr>" & vbNewLine & _
P & _
"< /w:tc>"
XmlTbl = XmlTbl & tc
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Else 'If .MergeCells < > True Then
'============================================================================
' Un Merge Cells
'============================================================================
Hght = .Height
Wdth = .Width
gridSpan = ""
'If IsTblBrdrSmlr(11) = False And IsTblBrdrSmlr(12) = False Then
For I = 1 To 4
Set Brd(I + 6) = .Borders(I + 6)
If I = 1 Or (Brd(I + 6).LineStyle <> xlNone And Brd(I + 6).Color = EdgClr And Brd(I + 6).Weight = Rngwt And Brd(I + 6).LineStyle = Rngstl) Then
IsRngBrdrSmlr = True
Else
IsRngBrdrSmlr = False: Exit For
End If
EdgClr = Brd(I + 6).Color: Rngwt = Brd(I + 6).Weight: Rngstl = Brd(I + 6).LineStyle
Next
'End If
TblWt = IIf(TBwt = -4138, 3, TBwt) / 1.5
If Rng.Column = Range(TVFP).Column Then
If Rng.Address = TVFP Then
Else
End If
Else
If RwNum = 0 Then
Else
End If
End If
Strclr = Right("000000" & Hex(EdgClr), 6)
Clr = Right(Strclr, 2) & Mid(Strclr, 3, 2) & Left(Strclr, 2)
' If IsTblBrdrSmlr(7) = False Or IsTblBrdrSmlr(8) = False Or IsTblBrdrSmlr(9) = False Or IsTblBrdrSmlr(10) = False Then
XmlBorder = "< w:tcBorders>" & vbNewLine
For I = 1 To 4
With .Borders(I + 6)
Strclr = Right("000000" & Hex(.Color), 6)
Clr = Right(Strclr, 2) & Mid(Strclr, 3, 2) & Left(Strclr, 2)
LnStl = IIf(.LineStyle = 1, "solid", IIf(.LineStyle = 4, "dot-Dash", IIf(.LineStyle = 5, "dot-Dot-Dash", IIf(.LineStyle = 13, "dash-Dot-Stroked", IIf(.LineStyle = -4115, "dashed", IIf(.LineStyle = -4118, "dotted", IIf(.LineStyle = -4119, "Double", "")))))))
MsoLnStl = IIf(.LineStyle = 1, "solid", IIf(.LineStyle = 4, "dot-Dash", IIf(.LineStyle = 5, "dot-Dot-Dash", IIf(.LineStyle = 13, "dash-Dot-Stroked", IIf(.LineStyle = -4115, "Dash", IIf(.LineStyle = -4118, "dotted", IIf(.LineStyle = -4119, "Double", "")))))))
XMsoLnStl = Replace(Trim(Replace(LnStl, "solid", "single")), "-", "")
Wt = IIf(.Weight = -4138, 3, .Weight) / 1.5
' Wt = Wt * (Wt * 0.25)
If InStr(1, LnStl, "Dash", vbTextCompare) Then LnStl = Replace(LnStl, LnStl, "dashed")
Proper = LnStl & " #" & Clr & " " & Wt & "pt"
If .LineStyle <> xlNone Then
'If (IsTblBrdrSmlr(11) = True And IsTblBrdrSmlr(12) = True) Or ((IsTblBrdrSmlr(11) = False Or IsTblBrdrSmlr(12) = False) And IsRngBrdrSmlr = True) Then
'msoBrdrs = msoBrdrs & ";mso-border-" & BrdEdg(I - 1) & "-alt:" & MsoLnStl & " #" & Clr & " " & Wt & "pt"
If (RwNum <> 0 And I = 2) Or (ClNum <> 0 And I = 1) Then
On Error Resume Next
If ((.Parent.Offset(-1, 0).MergeCells = True Or .Parent.Offset(-1, 0).EntireRow.Hidden = True) And I = 2) Or ((.Parent.Offset(0, -1).MergeCells = True Or .Parent.Offset(0, -1).EntireColumn.Hidden = True) And I = 1) Then
msoBrdrs = msoBrdrs & ";mso-border-" & BrdEdg(I - 1) & "-alt:" & MsoLnStl & " #" & Clr & " " & Wt & "pt"
XmlBorder = XmlBorder & "< w:" & BrdEdg(I - 1) & " w:val=""" & XMsoLnStl & """ w:color=""" & Clr & """ w:space=""" & 0 & """ w:sz=""" & Wt * 6 & """/>" & vbNewLine
Else
Brdrs = Brdrs & ";border-" & BrdEdg(I - 1) & ":none"
XmlBorder = XmlBorder & "< w:" & BrdEdg(I - 1) & " w:val=""nil""/>" & vbNewLine
End If
On Error GoTo 0
If LnStl = "solid" Or LnStl = "dotted" Then
'If I = 1 Then
' Brdrs = Brdrs & ";border-" & BrdEdg(I - 1) & ":" & Proper
' msoBrdrs = msoBrdrs & ";mso-border-" & BrdEdg(I - 1) & "-alt:" & MsoLnStl & " #" & Clr & " " & Wt & "pt"
' End If
Else
' If I = 1 Then
'border-top:dashed [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=C00000]#C00000[/URL]
'Brdrs = Brdrs & ";border-" & BrdEdg(I - 1) & ":" & LnStl & " #" & Clr & " " & Wt & "pt"
' msoBrdrs = msoBrdrs & ";mso-border-" & BrdEdg(I - 1) & "-alt:" & MsoLnStl & " #" & Clr & " " & Wt & "pt"
'End If
End If
Else
If InStr(1, LnStl, "Dash", vbTextCompare) Then LnStl = Replace(LnStl, LnStl, "dashed")
If Brdrs <> "" And InStr(Brdrs, Proper) <> 0 And (InStr(Brdrs, "border:") = 0 Or InStr(Brdrs, "border:" & Proper) <> 0) Then
Edg = Split(Brdrs, ";")
For E = LBound(Edg) To UBound(Edg)
Cnt = Cnt + LBound(Edg)
If Edg(E) <> "" And InStr(Edg(E), Proper) <> 0 Then
StrNum = InStr(Edg(E), "border") + Len("border") + Cnt
LngthNum = (Cnt + Len(Edg(E))) - (Len(Proper) + StrNum)
Brdrs = Replace(Brdrs, Mid(Edg(E), StrNum, LngthNum), "")
Else
End If
Next
Else
Brdrs = ";border-" & BrdEdg(I - 1) & ":" & Proper & Brdrs
End If
msoBrdrs = msoBrdrs & ";mso-border-" & BrdEdg(I - 1) & "-alt:" & MsoLnStl & " #" & Clr & " " & Wt & "pt"
XmlBorder = XmlBorder & "< w:" & BrdEdg(I - 1) & " w:val=""" & XMsoLnStl & """ w:color=""" & Clr & """ w:space=""" & 0 & """ w:sz=""" & Wt * 6 & """/>" & vbNewLine
End If
Else
Brdrs = Brdrs & ";border-" & BrdEdg(I - 1) & ":none"
XmlBorder = XmlBorder & "< w:" & BrdEdg(I - 1) & " w:val=""nil""/>" & vbNewLine
End If
End With
Next
XmlBorder = XmlBorder & "< /w:tcBorders>" '''
' End If
Brdrs = Brdrs & msoBrdrs
Strclr = Right("000000" & Hex(.Interior.Color), 6)
BClr = Right(Strclr, 2) & Mid(Strclr, 3, 2) & Left(Strclr, 2)
BckGrnd = IIf(.Interior.Pattern <> xlNone, ";background:#" & BClr, "")
XBckGrnd = ""
XBckGrnd = IIf(.Interior.Pattern <> xlNone, " w:fill=""" & BClr & """", "")
Ort = IIf(.Orientation = -4128, 0, IIf(.Orientation = -4171, 90, -90)) 'Orientation 0=-4128, 90=-4171, -90=-4170
Ornt = IIf(Ort = 0, "", IIf(Ort = 90, ";mso-rotate:" & 90, ";mso-rotate:" & -90))
HA = .HorizontalAlignment 'xlleft=-4131, xlcenter=-4108, xlright=-4152
VA = .VerticalAlignment 'xltop=-4160, xlcenter=-4108, xlbottom=-4107
valign = IIf(VA = xlTop, "top", IIf(VA = xlCenter, "center", "bottom"))
valign = IIf(Ort = 0, valign, IIf(Ort = 90, IIf(HA = xlLeft, "top", IIf(HA = xlRight, "bottom", "center")), IIf(HA = xlLeft, "bottom", IIf(HA = xlRight, "top", "center"))))
Align = IIf(HA = xlLeft, "left", IIf(HA = -4108, "center", "right"))
Align = IIf(Ort = 0, Align, IIf(Ort = 90, IIf(VA = xlTop, "right", IIf(VA = xlBottom, "left", "center")), IIf(VA = xlTop, "left", IIf(VA = xlBottom, "right", "center"))))
prgrph = Split(TextFormat(.Cells(1, 1)), "|")(0)
XMLprgrph = Split(TextFormat(.Cells(1, 1)), "|")(1)
With .Font
XNm = "": XB = "": XI = "": Estrk = "": XFClr = "": XSize = "": XSup = "": XSubs = ""
Nm = .Name: Size = .Size
XNm = "< w:rFonts w:ascii=""" & Nm & """ w:hAnsi=""" & Nm & """ w:cs=""" & Nm & """/>"
XSize = "< w:sz w:val=""" & Size * 2 & """/>< w:szCs w:val=""" & Size * 2 & """/>"
Strclr = Right("000000" & Hex(.Color), 6)
FClr = Right(Strclr, 2) & Mid(Strclr, 3, 2) & Left(Strclr, 2)
XFClr = "< w:color w:val=""" & FClr & """/>"
If .Bold = True Then XB = "< w:b/>" & vbNewLine & "< w:bCs/>" & vbNewLine
If .Italic = True Then XI = "< w:i/>" & vbNewLine & "< w:iCs/>" & vbNewLine
If .Underline = 2 Then Xu = "< w:u w:val=""single""/>" & vbNewLine
If .Underline = -4119 Then Xu2 = "< w:u w:val=""double""/>" & vbNewLine
If .Strikethrough = True Then Estrk = "< /strike>" & vbNewLine
If .Superscript = True Then XSup = "< w:vertAlign w:val=""superscript""/>" & vbNewLine
If .Subscript = True Then XSubs = "< w:vertAlign w:val=""Subscript""/>" & vbNewLine
XF = XNm & XB & XI & Estrk & XFClr & XSize & XSup & XSubs
End With
P = "< w:p w:rsidR=""00B527A5"" w:rsidRDefault=""00B527A5"">" & vbNewLine & _
"< w:pPr>" & vbNewLine & _
"< w:bidi w:val=""0""/>" & vbNewLine & _
"< w:spacing w:after=""0""/>" & vbNewLine & _
"< w:jc w:val=""" & Align & """/>" & vbNewLine & _
"< w:rPr>" & vbNewLine & _
XF & vbNewLine & _
"< /w:rPr>" & vbNewLine & _
"< /w:pPr>" & vbNewLine & _
XMLprgrph & vbNewLine & _
"< /w:p>"
TD = "width=" & Wdth & " valign=" & valign & " style='width:" & Wdth * 1 & "pt" & Brdrs & BckGrnd & ";padding:0in 0in 0in 0in" & Ornt & ";height:" & Hght & "pt"
TextDirection = IIf(Ort = 90, "< w:textDirection w:val=""btLr""/>", IIf(Ort = -90, "< w:textDirection w:val=""tbRl""/>", ""))
tc = ""
tc = "< w:tc>" & vbNewLine & _
"< w:tcPr>" & vbNewLine & _
"< w:tcW w:w=""" & Wdth * 20 & """ w:type=""dxa""/>" & _
gridSpan & vbNewLine & _
XmlBorder & _
"< w:shd w:val=""" & "Clear" & """ w:color=""auto""" & XBckGrnd & "/>" & vbNewLine & _
TextDirection & _
"< w:vAlign w:val=""" & LCase(valign) & """/>" & vbNewLine & _
"< w:hideMark/>" & vbNewLine & _
"< /w:tcPr>" & vbNewLine & _
P & _
"< /w:tc>"
HtmTbl = HtmTbl & " < td " & TD & "'>" & prgrph & "< /td>" & vbNewLine
XmlTbl = XmlTbl & tc
'''''''If .Address = "$C$2" Then Cells(.Row + 10, .Column) = tc
End If 'MergeCells
If .Column = Range(TVLP).Column Then
HtmTbl = HtmTbl & "< /tr>" & vbNewLine
XmlTbl = XmlTbl & "< /w:tr>" & vbNewLine
End If
End If 'row.Column.Hidden < w:jc w:val="right"/>
End With 'Rng
Next ' Rng In .Range(TVRA)
HtmTbl = HtmTbl & "< /table>" & vbNewLine & "< /div>" & vbNewLine & "< /div>" & vbNewLine & "< /body>" & vbNewLine & "< /html>"
XmlTbl = XmlTbl & "< /w:tbl>"
XmlTbl = XmlTbl & "< /w:body>< /w:document>"
End With ' WS
GetTable = HtmTbl & "|" & XmlTbl
End Function
Public Function TextFormat(Rng As Range)
Dim Nm As String, Size As Long, Clr As Long, Bold As Boolean, Italic As Boolean, Underline As Long, Strikethrough As Boolean, Superscript As Boolean, Subscript As Boolean
Dim b As String, EB As String, I As String, EI As String, u As String, EU As String, strk As String, Estrk As String, Sup As String, ESup As String, Subs As String, ESubs As String
Dim Align As String, TXT As String, T As String, FClr As String, XFClr As String, XB As String, XI As String, Xu As String, Xu2 As String, M As String
Dim N As Long
Dim FC As String, C As String, span As String, Espan As String, XNm As String, XSize As String, XSup As String, XSubs As String, XF As String, HrAlgn As String
Dim XM As String, Hm As String, HTextFormat As String, XTextFormat As String, Ornt As String
Dim Ort As Long, HA As Long, VA As Long
With Rng
TXT = .Text
Ort = IIf(.Orientation = -4128, 0, IIf(.Orientation = -4171, 90, -90)) 'Orientation 0=-4128, 90=-4171, -90=-4170
Ornt = IIf(Ort = 0, "", IIf(Ort = 90, ";mso-rotate:" & 90, ";mso-rotate:" & -90))
HA = .HorizontalAlignment 'xlleft=-4131, xlcenter=-4108, xlright=-4152
VA = .VerticalAlignment 'xltop=-4160, xlcenter=-4108, xlbottom=-4107
Align = IIf(HA = xlLeft, ";text-align:left", IIf(HA = xlCenter, ";text-align:center", ";text-align:right"))
Align = IIf(Ort = 0, Align, IIf(Ort = 90, IIf(VA = xlTop, ";text-align:right", IIf(VA = xlBottom, ";text-align:left", ";text-align:center")), IIf(VA = xlTop, ";text-align:left", IIf(VA = xlBottom, ";text-align:right", ";text-align:center"))))
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For N = 1 To Len(TXT) + 1 '< < < < <
' If Trim(TXT) = "" Then Exit For
With .Characters(Start:=N, Length:=1)
T = Mid(TXT, N, 1)
With .Font 'Characters Font
FClr = "": XFClr = "": b = "": EB = "": I = "": EI = "": u = "": EU = "": strk = "": Estrk = "": Sup = "": ESup = "": Subs = "": ESubs = "": XB = "": XI = "": Xu = "": Xu2 = ""
If N = 1 Or (Nm = .Name And Size = .Size And Clr = .Color And Bold = .Bold And Italic = .Italic And Underline = .Underline And Superscript = .Superscript And Subscript = .Subscript And N <= Len(TXT)) Then
M = M & T
Nm = .Name: Size = .Size: Clr = .Color: Bold = .Bold: Italic = .Italic: Underline = .Underline: Strikethrough = .Strikethrough: Superscript = .Superscript: Subscript = .Subscript ' Rest
Else 'Here foramt
FC = Right("000000" & Hex(Clr), 6)
C = Right(FC, 2) & Mid(FC, 3, 2) & Left(FC, 2)
FClr = IIf(Clr <> 0, "color:" & "#" & C & ";", "")
If Clr <> 0 Then FClr = "color:" & "#" & Right(FC, 2) & Mid(FC, 3, 2) & Left(FC, 2) & ";": XFClr = "< w:color w:val=""" & C & """/>"
span = "< span dir=LTR style='font-size:" & Size & "pt;font-family:" & Nm & ",serif;" & FClr & "'>": Espan = "< /span>"
XNm = "< w:rFonts w:ascii=""" & Nm & """ w:hAnsi=""" & Nm & """ w:cs=""" & Nm & """/>"
XSize = "< w:sz w:val=""" & Size * 2 & """/>< w:szCs w:val=""" & Size * 2 & """/>"
If Bold = True Then b = "< b>": EB = "< /b>": b = "< b>": EB = "< /b>": XB = "< w:b/>< w:bCs/>"
If Italic = True Then I = "< i>": EI = "< /i>": XI = "< w:i/>< w:iCs/>"
If Underline = 2 Then u = "< u>": EU = "< /u>": Xu = "< w:u w:val=""single""/>"
If Underline = -4119 Then u = "< u>": EI = "< /u>": Xu2 = "< w:u w:val=""double""/>"
If Strikethrough = True Then strk = "< strike>": Estrk = "< /strike>"
If Superscript = True Then Sup = "< Sup>": ESup = "< /Sup>": XSup = "< w:vertAlign w:val=""superscript""/>"
If Subscript = True Then Subs = "< Sub>": ESubs = "< /Sub>": XSubs = "< w:vertAlign w:val=""Subscript""/>"
XF = XNm & XB & XI & Estrk & XFClr & XSize & XSup & XSubs
XM = "< w:r>" & vbNewLine & _
"< w:rPr>" & vbNewLine & _
XF & vbNewLine & _
"< /w:rPr>" & vbNewLine & _
"< w:t>" & M & "< /w:t>" & vbNewLine & _
"< /w:r>" & vbNewLine
Hm = b & I & u & strk & Subs & Sup & span & M & Espan & ESup & ESubs & Estrk & EU & EI & EB
Hm = vbNewLine & "< p class=MsoNormal dir=LTR style='margin-top:-0.01in;margin-right:0.01in;margin-bottom:-0.01in;margin-left:0.01in" & Align & ";line-height:normal;direction:ltr;unicode-bidi:embed'>" & Hm & "< /p>"
Nm = .Name: Size = .Size: Clr = .Color: Bold = .Bold: Italic = .Italic: Underline = .Underline: Strikethrough = .Strikethrough: Superscript = .Superscript: Subscript = .Subscript ' Rest
HTextFormat = HTextFormat & Hm: XTextFormat = XTextFormat & XM & vbNewLine 'Format similarities
M = "": M = T '< < < < < Clear old and gather new Changes
End If
End With 'Characters Font
End With
Next N
End With
TextFormat = HTextFormat & "|" & XTextFormat
End Function
Public Sub creatDocx(WS As Worksheet, TblRng As Range)
'Application.ScreenUpdating = False
Dim wrdApp As Object
Dim wrdDoc As Object
Dim TmpPath As String, DefultPath As String, DocxPath As String, DocxFile As String, ZipPath As Variant, ZipFile As String, FolderPath As Variant
Dim relsFolderPath As String, docPropsFolderPath As String, WordFolderPath As String, relsWordFolderPath As String, themeWordFolderPath As String
Dim rels As String, appxml As String, corexml As String, theme1xml As String, fontTablexml As String, settingsxml As String, stylesxml As String, webSettingsxml As String, customxml As String, documentxmlrels As String, documentxml As String, Content_Typesxml As String, Content_TypeFolder As String
Dim ShellApp As Object
Dim fso As Object
Dim queue As Collection
Dim FF As Object
Dim SubF As Object
Dim file As Object
Dim N As Long
DefultPath = ThisWorkbook.Path & ""
TmpPath = Environ("temp") & ""
DocxFile = "Doc1.docx"
DocxPath = DefultPath & DocxFile
'Close exist and deleted File
On Error Resume Next
Set wrdDoc = GetObject(DocxPath)
If wrdDoc Is Nothing Then
Kill DocxPath
Else
wrdDoc.Parent.Quit
wrdDoc.Close
Kill DocxPath
End If
On Error GoTo 0
'Create an empty zip file
ZipFile = Split(DocxFile, ".")(0) & ".Zip": ZipPath = TmpPath & ZipFile
If Len(Dir(ZipPath)) <> 0 Then Kill ZipPath
Open ZipPath For Output As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] : Print [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0): Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL]
'
Set fso = CreateObject("scripting.filesystemobject")
FolderPath = TmpPath & "root"
If Len(Dir(FolderPath, vbDirectory)) = 0 Then
MkDir FolderPath
Else
On Error Resume Next
fso.deletefolder FolderPath
MkDir FolderPath
On Error GoTo 0
On Error Resume Next
Do Until Len(Dir(FolderPath, vbDirectory)) > 0
Application.Wait (Now + TimeValue("0:00:02"))
Loop
On Error GoTo 0
'Call subRefreshDesktop
End If
relsFolderPath = FolderPath & "" & "_rels"
docPropsFolderPath = FolderPath & "" & "docProps"
WordFolderPath = FolderPath & "" & "word"
relsWordFolderPath = WordFolderPath & "" & "" & "_rels"
themeWordFolderPath = WordFolderPath & "" & "" & "theme"
Content_TypeFolder = FolderPath
'Create Folders
'On Error GoTo CreatrFolder:
MkDir relsFolderPath
MkDir docPropsFolderPath
MkDir WordFolderPath
MkDir relsWordFolderPath
MkDir themeWordFolderPath
'Create XML Filess
appxml = "< ?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" & vbNewLine & _
"< Properties xmlns=""http://schemas.openxmlformats.org/officeDocument/2006/extended-properties"" xmlns:vt=""http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes"">< Template>Normal.dotm< /Template>< TotalTime>1< /TotalTime>< Pages>1< /Pages>< Words>12< /Words>< Characters>74< /Characters>< Application>Microsoft Office Word< /Application>< DocSecurity>0< /DocSecurity>< Lines>1< /Lines>< Paragraphs>1< /Paragraphs>< ScaleCrop>false< /ScaleCrop>< HeadingPairs>< vt:vector size=""2"" baseType=""variant"">< vt:variant>< vt:lpstr>Title< /vt:lpstr>< /vt:variant>< vt:variant>< vt:i4>1< /vt:i4>< /vt:variant>< /vt:vector>< /HeadingPairs>< TitlesOfParts>< vt:vector size=""1"" baseType=""lpstr"">< vt:lpstr>< /vt:lpstr>< /vt:vector>< /TitlesOfParts>< Company>< /Company>< LinksUpToDate>false< /LinksUpToDate>< CharactersWithSpaces>85< /CharactersWithSpaces>< SharedDoc>false< /SharedDoc>< HyperlinksChanged>false< /HyperlinksChanged>< AppVersion>16.0000< /AppVersion>< /Properties>"
Call ToFile(appxml, docPropsFolderPath, "app", "xml")
corexml = "< ?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" & vbNewLine & _
"< cp:coreProperties xmlns:cp=""http://schemas.openxmlformats.org/package/2006/metadata/core-properties"" xmlns:dc=""http://purl.org/dc/elements/1.1/"" xmlns:dcterms=""http://purl.org/dc/terms/"" xmlns:dcmitype=""http://purl.org/dc/dcmitype/"" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"">< dc:title>< /dc:title>< dc:subject>< /dc:subject>< dc:creator>< /dc:creator>< cp:keywords>< /cp:keywords>< dc:description>< /dc:description>< cp:lastModifiedBy>< /cp:lastModifiedBy>< cp:revision>2< /cp:revision>< dcterms:created xsi:type=""dcterms:W3CDTF"">2018-03-14T02:12:00Z< /dcterms:created>< dcterms:modified xsi:type=""dcterms:W3CDTF"">2018-03-14T02:12:00Z< /dcterms:modified>< /cp:coreProperties>"
Call ToFile(corexml, docPropsFolderPath, "core", "xml")
'Add theme1
theme1xml = ""
theme1xml = theme1xml & "< ?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" & vbNewLine & _
"< a:theme xmlns:a=""http://schemas.openxmlformats.org/drawingml/2006/main"" name=""??? Office"">" & vbNewLine & "< a:themeElements>" & vbNewLine & "< a:clrScheme name=""Office"">" & vbNewLine & "< a:dk1>" & vbNewLine & "< a:sysClr val=""windowText"" lastClr=""000000""/>" & vbNewLine & "< /a:dk1>" & vbNewLine & "< a:lt1>" & vbNewLine & "< a:sysClr val=""window"" lastClr=""FFFFFF""/>" & vbNewLine & "< /a:lt1>" & vbNewLine & "< a:dk2>" & vbNewLine & "< a:srgbClr val=""44546A""/>" & vbNewLine & "< /a:dk2>" & vbNewLine & "< a:lt2>" & vbNewLine & "< a:srgbClr val=""E7E6E6""/>" & vbNewLine & "< /a:lt2>" & vbNewLine & "< a:accent1>" & vbNewLine & "< a:srgbClr val=""4472C4""/>" & vbNewLine & "< /a:accent1>" & vbNewLine & "< a:accent2>" & vbNewLine & "< a:srgbClr val=""ED7D31""/>" & vbNewLine & _
"< /a:accent2>" & vbNewLine & "< a:accent3>" & vbNewLine & "< a:srgbClr val=""A5A5A5""/>" & vbNewLine & "< /a:accent3>" & vbNewLine & "< a:accent4>" & vbNewLine & "< a:srgbClr val=""FFC000""/>" & vbNewLine & "< /a:accent4>" & vbNewLine & "< a:accent5>" & vbNewLine & "< a:srgbClr val=""5B9BD5""/>" & vbNewLine & "< /a:accent5>" & vbNewLine & "< a:accent6>" & vbNewLine & "< a:srgbClr val=""70AD47""/>" & vbNewLine & "< /a:accent6>" & vbNewLine & "< a:hlink>" & vbNewLine & "< a:srgbClr val=""0563C1""/>" & vbNewLine & "< /a:hlink>" & vbNewLine & "< a:folHlink>" & vbNewLine & "< a:srgbClr val=""954F72""/>" & vbNewLine & "< /a:folHlink>" & vbNewLine & "< /a:clrScheme>" & vbNewLine & "< a:fontScheme name=""Office"">" & vbNewLine & "< a:majorFont>" & vbNewLine & "< a:latin typeface=""Calibri Light"" panose=""020F0302020204030204""/>" & vbNewLine & "< a:ea typeface=""""/>" & vbNewLine & _
"< a:cs typeface=""""/>" & vbNewLine & "< a:font script=""Jpan"" typeface=""????? Light""/>" & vbNewLine & "< a:font script=""Hang"" typeface=""?? ??""/>" & vbNewLine & "< a:font script=""Hans"" typeface=""?? Light""/>" & vbNewLine & "< a:font script=""Hant"" typeface=""????""/>" & vbNewLine & "< a:font script=""Arab"" typeface=""Times New Roman""/>" & vbNewLine & "< a:font script=""Hebr"" typeface=""Times New Roman""/>" & vbNewLine & "< a:font script=""Thai"" typeface=""Angsana New""/>" & vbNewLine & "< a:font script=""Ethi"" typeface=""Nyala""/>" & vbNewLine & "< a:font script=""Beng"" typeface=""Vrinda""/>" & vbNewLine & "< a:font script=""Gujr"" typeface=""Shruti""/>" & vbNewLine & "< a:font script=""Khmr"" typeface=""MoolBoran""/>" & vbNewLine & "< a:font script=""Knda"" typeface=""Tunga""/>" & vbNewLine & "< a:font script=""Guru"" typeface=""Raavi""/>" & vbNewLine & _
"< a:font script=""Cans"" typeface=""Euphemia""/>" & vbNewLine & "< a:font script=""Cher"" typeface=""Plantagenet Cherokee""/>" & vbNewLine & "< a:font script=""Yiii"" typeface=""Microsoft Yi Baiti""/>" & vbNewLine & "< a:font script=""Tibt"" typeface=""Microsoft Himalaya""/>" & vbNewLine & "< a:font script=""Thaa"" typeface=""MV Boli""/>" & vbNewLine & "< a:font script=""Deva"" typeface=""Mangal""/>" & vbNewLine & "< a:font script=""Telu"" typeface=""Gautami""/>" & vbNewLine & "< a:font script=""Taml"" typeface=""Latha""/>" & vbNewLine & "< a:font script=""Syrc"" typeface=""Estrangelo Edessa""/>" & vbNewLine & "< a:font script=""Orya"" typeface=""Kalinga""/>" & vbNewLine & "< a:font script=""Mlym"" typeface=""Kartika""/>" & vbNewLine & "< a:font script=""Laoo"" typeface=""DokChampa""/>" & vbNewLine & "< a:font script=""Sinh"" typeface=""Iskoola Pota""/>" & vbNewLine & _
"< a:font script=""Mong"" typeface=""Mongolian Baiti""/>" & vbNewLine & "< a:font script=""Viet"" typeface=""Times New Roman""/>" & vbNewLine & "< a:font script=""Uigh"" typeface=""Microsoft Uighur""/>" & vbNewLine & "< a:font script=""Geor"" typeface=""Sylfaen""/>" & vbNewLine & "< a:font script=""Armn"" typeface=""Arial""/>" & vbNewLine & "< a:font script=""Bugi"" typeface=""Leelawadee UI""/>" & vbNewLine & "< a:font script=""Bopo"" typeface=""Microsoft JhengHei""/>" & vbNewLine & "< a:font script=""Java"" typeface=""Javanese Text""/>" & vbNewLine & "< a:font script=""Lisu"" typeface=""Segoe UI""/>" & vbNewLine & "< a:font script=""Mymr"" typeface=""Myanmar Text""/>" & vbNewLine & "< a:font script=""Nkoo"" typeface=""Ebrima""/>" & vbNewLine & "< a:font script=""Olck"" typeface=""Nirmala UI""/>" & vbNewLine & "< a:font script=""Osma"" typeface=""Ebrima""/>" & vbNewLine & _
"< a:font script=""Phag"" typeface=""Phagspa""/>" & vbNewLine & "< a:font script=""Syrn"" typeface=""Estrangelo Edessa""/>" & vbNewLine & "< a:font script=""Syrj"" typeface=""Estrangelo Edessa""/>" & vbNewLine & "< a:font script=""Syre"" typeface=""Estrangelo Edessa""/>" & vbNewLine & "< a:font script=""Sora"" typeface=""Nirmala UI""/>" & vbNewLine & "< a:font script=""Tale"" typeface=""Microsoft Tai Le""/>" & vbNewLine & "< a:font script=""Talu"" typeface=""Microsoft New Tai Lue""/>" & vbNewLine & "< a:font script=""Tfng"" typeface=""Ebrima""/>" & vbNewLine & "< /a:majorFont>" & vbNewLine & "< a:minorFont>" & vbNewLine & "< a:latin typeface=""Calibri"" panose=""020F0502020204030204""/>" & vbNewLine & "< a:ea typeface=""""/>" & vbNewLine & "< a:cs typeface=""""/>" & vbNewLine & "< a:font script=""Jpan"" typeface=""???""/>" & vbNewLine & "< a:font script=""Hang"" typeface=""?? ??""/>" & vbNewLine & _
"< a:font script=""Hans"" typeface=""??""/>" & vbNewLine & "< a:font script=""Hant"" typeface=""????""/>" & vbNewLine & "< a:font script=""Arab"" typeface=""Arial""/>" & vbNewLine & "< a:font script=""Hebr"" typeface=""Arial""/>" & vbNewLine & "< a:font script=""Thai"" typeface=""Cordia New""/>" & vbNewLine & "< a:font script=""Ethi"" typeface=""Nyala""/>" & vbNewLine & "< a:font script=""Beng"" typeface=""Vrinda""/>" & vbNewLine & "< a:font script=""Gujr"" typeface=""Shruti""/>" & vbNewLine & "< a:font script=""Khmr"" typeface=""DaunPenh""/>" & vbNewLine & "< a:font script=""Knda"" typeface=""Tunga""/>" & vbNewLine & "< a:font script=""Guru"" typeface=""Raavi""/>" & vbNewLine & "< a:font script=""Cans"" typeface=""Euphemia""/>" & vbNewLine & "< a:font script=""Cher"" typeface=""Plantagenet Cherokee""/>" & vbNewLine & "< a:font script=""Yiii"" typeface=""Microsoft Yi Baiti""/>" & vbNewLine & _
"< a:font script=""Tibt"" typeface=""Microsoft Himalaya""/>" & vbNewLine & "< a:font script=""Thaa"" typeface=""MV Boli""/>" & vbNewLine & "< a:font script=""Deva"" typeface=""Mangal""/>" & vbNewLine & "< a:font script=""Telu"" typeface=""Gautami""/>" & vbNewLine & "< a:font script=""Taml"" typeface=""Latha""/>" & vbNewLine & "< a:font script=""Syrc"" typeface=""Estrangelo Edessa""/>" & vbNewLine & "< a:font script=""Orya"" typeface=""Kalinga""/>" & vbNewLine & "< a:font script=""Mlym"" typeface=""Kartika""/>" & vbNewLine & "< a:font script=""Laoo"" typeface=""DokChampa""/>" & vbNewLine & "< a:font script=""Sinh"" typeface=""Iskoola Pota""/>" & vbNewLine & "< a:font script=""Mong"" typeface=""Mongolian Baiti""/>" & vbNewLine & "< a:font script=""Viet"" typeface=""Arial""/>" & vbNewLine & "< a:font script=""Uigh"" typeface=""Microsoft Uighur""/>" & vbNewLine & _
"< a:font script=""Geor"" typeface=""Sylfaen""/>" & vbNewLine & "< a:font script=""Armn"" typeface=""Arial""/>" & vbNewLine & "< a:font script=""Bugi"" typeface=""Leelawadee UI""/>" & vbNewLine & "< a:font script=""Bopo"" typeface=""Microsoft JhengHei""/>" & vbNewLine & "< a:font script=""Java"" typeface=""Javanese Text""/>" & vbNewLine & "< a:font script=""Lisu"" typeface=""Segoe UI""/>" & vbNewLine & "< a:font script=""Mymr"" typeface=""Myanmar Text""/>" & vbNewLine & "< a:font script=""Nkoo"" typeface=""Ebrima""/>" & vbNewLine & "< a:font script=""Olck"" typeface=""Nirmala UI""/>" & vbNewLine & "< a:font script=""Osma"" typeface=""Ebrima""/>" & vbNewLine & "< a:font script=""Phag"" typeface=""Phagspa""/>" & vbNewLine & "< a:font script=""Syrn"" typeface=""Estrangelo Edessa""/>" & vbNewLine & "< a:font script=""Syrj"" typeface=""Estrangelo Edessa""/>" & vbNewLine & _
"< a:font script=""Syre"" typeface=""Estrangelo Edessa""/>" & vbNewLine & "< a:font script=""Sora"" typeface=""Nirmala UI""/>" & vbNewLine & "< a:font script=""Tale"" typeface=""Microsoft Tai Le""/>" & vbNewLine & "< a:font script=""Talu"" typeface=""Microsoft New Tai Lue""/>" & vbNewLine & "< a:font script=""Tfng"" typeface=""Ebrima""/>" & vbNewLine & "< /a:minorFont>" & vbNewLine & "< /a:fontScheme>" & vbNewLine & "< a:fmtScheme name=""Office"">" & vbNewLine & "< a:fillStyleLst>" & vbNewLine & "< a:solidFill>" & vbNewLine & "< a:schemeClr val=""phClr""/>" & vbNewLine & "< /a:solidFill>" & vbNewLine & "< a:gradFill rotWithShape=""1"">" & vbNewLine & "< a:gsLst>" & vbNewLine & "< a:gs pos=""0"">" & vbNewLine & "< a:schemeClr val=""phClr"">" & vbNewLine & "< a:lumMod val=""110000""/>" & vbNewLine & "< a:satMod val=""105000""/>" & vbNewLine & "< a:tint val=""67000""/>" & vbNewLine & _
"< /a:schemeClr>" & vbNewLine & "< /a:gs>" & vbNewLine & "< a:gs pos=""50000"">" & vbNewLine & "< a:schemeClr val=""phClr"">" & vbNewLine & "< a:lumMod val=""105000""/>" & vbNewLine & "< a:satMod val=""103000""/>" & vbNewLine & "< a:tint val=""73000""/>" & vbNewLine & "< /a:schemeClr>" & vbNewLine & "< /a:gs>" & vbNewLine & "< a:gs pos=""100000"">" & vbNewLine & "< a:schemeClr val=""phClr"">" & vbNewLine & "< a:lumMod val=""105000""/>" & vbNewLine & "< a:satMod val=""109000""/>" & vbNewLine & "< a:tint val=""81000""/>" & vbNewLine & "< /a:schemeClr>" & vbNewLine & "< /a:gs>" & vbNewLine & "< /a:gsLst>" & vbNewLine & "< a:lin ang=""5400000"" scaled=""0""/>" & vbNewLine & "< /a:gradFill>" & vbNewLine & "< a:gradFill rotWithShape=""1"">" & vbNewLine & "< a:gsLst>" & vbNewLine & "< a:gs pos=""0"">" & vbNewLine & "< a:schemeClr val=""phClr"">" & vbNewLine & "< a:satMod val=""103000""/>" & vbNewLine & _
"< a:lumMod val=""102000""/>" & vbNewLine & "< a:tint val=""94000""/>" & vbNewLine & "< /a:schemeClr>" & vbNewLine & "< /a:gs>" & vbNewLine & "< a:gs pos=""50000"">" & vbNewLine & "< a:schemeClr val=""phClr"">" & vbNewLine & "< a:satMod val=""110000""/>" & vbNewLine & "< a:lumMod val=""100000""/>" & vbNewLine & "< a:shade val=""100000""/>" & vbNewLine & "< /a:schemeClr>" & vbNewLine & "< /a:gs>" & vbNewLine & "< a:gs pos=""100000"">" & vbNewLine & "< a:schemeClr val=""phClr"">" & vbNewLine & "< a:lumMod val=""99000""/>" & vbNewLine & "< a:satMod val=""120000""/>" & vbNewLine & "< a:shade val=""78000""/>" & vbNewLine & "< /a:schemeClr>" & vbNewLine & "< /a:gs>" & vbNewLine & "< /a:gsLst>" & vbNewLine & "< a:lin ang=""5400000"" scaled=""0""/>" & vbNewLine & "< /a:gradFill>" & vbNewLine & "< /a:fillStyleLst>" & vbNewLine & "< a:lnStyleLst>" & vbNewLine & "< a:ln w=""6350"" cap=""flat"" cmpd=""sng"" algn=""ctr"">" & vbNewLine & _
"< a:solidFill>" & vbNewLine & "< a:schemeClr val=""phClr""/>" & vbNewLine & "< /a:solidFill>" & vbNewLine & "< a:prstDash val=""solid""/>" & vbNewLine & "< a:miter lim=""800000""/>" & vbNewLine & "< /a:ln>" & vbNewLine & "< a:ln w=""12700"" cap=""flat"" cmpd=""sng"" algn=""ctr"">" & vbNewLine & "< a:solidFill>" & vbNewLine & "< a:schemeClr val=""phClr""/>" & vbNewLine & "< /a:solidFill>" & vbNewLine & "< a:prstDash val=""solid""/>" & vbNewLine & "< a:miter lim=""800000""/>" & vbNewLine & "< /a:ln>" & vbNewLine & "< a:ln w=""19050"" cap=""flat"" cmpd=""sng"" algn=""ctr"">" & vbNewLine & "< a:solidFill>" & vbNewLine & "< a:schemeClr val=""phClr""/>" & vbNewLine & "< /a:solidFill>" & vbNewLine & "< a:prstDash val=""solid""/>" & vbNewLine & "< a:miter lim=""800000""/>" & vbNewLine & "< /a:ln>" & vbNewLine & "< /a:lnStyleLst>" & vbNewLine & "< a:effectStyleLst>" & vbNewLine & _
"< a:effectStyle>" & vbNewLine & "< a:effectLst/>" & vbNewLine & "< /a:effectStyle>" & vbNewLine & "< a:effectStyle>" & vbNewLine & "< a:effectLst/>" & vbNewLine & "< /a:effectStyle>" & vbNewLine & "< a:effectStyle>" & vbNewLine & "< a:effectLst>" & vbNewLine & "< a:outerShdw blurRad=""57150"" dist=""19050"" dir=""5400000"" algn=""ctr"" rotWithShape=""0"">" & vbNewLine & "< a:srgbClr val=""000000"">" & vbNewLine & "< a:alpha val=""63000""/>" & vbNewLine & "< /a:srgbClr>" & vbNewLine & "< /a:outerShdw>" & vbNewLine & "< /a:effectLst>" & vbNewLine & "< /a:effectStyle>" & vbNewLine & "< /a:effectStyleLst>" & vbNewLine & "< a:bgFillStyleLst>" & vbNewLine & "< a:solidFill>" & vbNewLine & "< a:schemeClr val=""phClr""/>" & vbNewLine & "< /a:solidFill>" & vbNewLine & "< a:solidFill>" & vbNewLine & "< a:schemeClr val=""phClr"">" & vbNewLine & "< a:tint val=""95000""/>" & vbNewLine & _
"< a:satMod val=""170000""/>" & vbNewLine & "< /a:schemeClr>" & vbNewLine & "< /a:solidFill>" & vbNewLine & "< a:gradFill rotWithShape=""1"">" & vbNewLine & "< a:gsLst>" & vbNewLine & "< a:gs pos=""0"">" & vbNewLine & "< a:schemeClr val=""phClr"">" & vbNewLine & "< a:tint val=""93000""/>" & vbNewLine & "< a:satMod val=""150000""/>" & vbNewLine & "< a:shade val=""98000""/>" & vbNewLine & "< a:lumMod val=""102000""/>" & vbNewLine & "< /a:schemeClr>" & vbNewLine & "< /a:gs>" & vbNewLine & "< a:gs pos=""50000"">" & vbNewLine & "< a:schemeClr val=""phClr"">" & vbNewLine & "< a:tint val=""98000""/>" & vbNewLine & "< a:satMod val=""130000""/>" & vbNewLine & "< a:shade val=""90000""/>" & vbNewLine & "< a:lumMod val=""103000""/>" & vbNewLine & "< /a:schemeClr>" & vbNewLine & "< /a:gs>" & vbNewLine & "< a:gs pos=""100000"">" & vbNewLine & "< a:schemeClr val=""phClr"">" & vbNewLine & _
"< a:shade val=""63000""/>" & vbNewLine & "< a:satMod val=""120000""/>" & vbNewLine & "< /a:schemeClr>" & vbNewLine & "< /a:gs>" & vbNewLine & "< /a:gsLst>" & vbNewLine & "< a:lin ang=""5400000"" scaled=""0""/>" & vbNewLine & "< /a:gradFill>" & vbNewLine & "< /a:bgFillStyleLst>" & vbNewLine & "< /a:fmtScheme>" & vbNewLine & "< /a:themeElements>" & vbNewLine & "< a:objectDefaults/>" & vbNewLine & "< a:extraClrSchemeLst/>" & vbNewLine & "< a:extLst>" & vbNewLine & "< a:ext uri=""{05A4C25C-085E-4340-85A3-A5531E510DB2}"">" & vbNewLine & "< thm15:themeFamily xmlns:thm15=""http://schemas.microsoft.com/office/thememl/2012/main"" name=""Office Theme"" id=""{62F939B6-93AF-4DB8-9C6B-D6C7DFDC589F}"" vid=""{4A3C46E8-61CC-4603-A589-7422A47A8E4A}""/>" & vbNewLine & "< /a:ext>" & vbNewLine & "< /a:extLst>" & vbNewLine & "< /a:theme>"
Call ToFile(theme1xml, themeWordFolderPath, "theme1", "xml")
theme1xml = ""
'Add fontTable
fontTablexml = ""
fontTablexml = fontTablexml & "< ?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" & vbNewLine & _
"< w:fonts xmlns:mc=""http://schemas.openxmlformats.org/markup-compatibility/2006"" xmlns:r=""http://schemas.openxmlformats.org/officeDocument/2006/relationships"" xmlns:w=""http://schemas.openxmlformats.org/wordprocessingml/2006/main"" xmlns:w14=""http://schemas.microsoft.com/office/word/2010/wordml"" xmlns:w15=""http://schemas.microsoft.com/office/word/2012/wordml"" xmlns:w16cid=""http://schemas.microsoft.com/office/word/2016/wordml/cid"" xmlns:w16se=""http://schemas.microsoft.com/office/word/2015/wordml/symex"" mc:Ignorable=""w14 w15 w16se w16cid"">" & vbNewLine & "< w:font w:name=""Wingdings"">" & vbNewLine & "< w:panose1 w:val=""05000000000000000000""/>" & vbNewLine & "< w:charset w:val=""02""/>" & vbNewLine & "< w:family w:val=""auto""/>" & vbNewLine & "< w:pitch w:val=""variable""/>" & vbNewLine & _
"< w:sig w:usb0=""00000000"" w:usb1=""10000000"" w:usb2=""00000000"" w:usb3=""00000000"" w:csb0=""80000000"" w:csb1=""00000000""/>" & vbNewLine & "< /w:font>" & vbNewLine & "< w:font w:name=""Times New Roman"">" & vbNewLine & "< w:panose1 w:val=""02020603050405020304""/>" & vbNewLine & "< w:charset w:val=""00""/>" & vbNewLine & "< w:family w:val=""roman""/>" & vbNewLine & "< w:pitch w:val=""variable""/>" & vbNewLine & "< w:sig w:usb0=""E0002EFF"" w:usb1=""C000785B"" w:usb2=""00000009"" w:usb3=""00000000"" w:csb0=""000001FF"" w:csb1=""00000000""/>" & vbNewLine & "< /w:font>" & vbNewLine & "< w:font w:name=""Courier New"">" & vbNewLine & "< w:panose1 w:val=""02070309020205020404""/>" & vbNewLine & "< w:charset w:val=""00""/>" & vbNewLine & "< w:family w:val=""modern""/>" & vbNewLine & "< w:pitch w:val=""fixed""/>" & vbNewLine & "< w:sig w:usb0=""E0002EFF"" w:usb1=""C0007843"" w:usb2=""00000009"" w:usb3=""00000000"" w:csb0=""000001FF"" w:csb1=""00000000""/>" & vbNewLine & _
"< /w:font>" & vbNewLine & "< w:font w:name=""Symbol"">" & vbNewLine & "< w:panose1 w:val=""05050102010706020507""/>" & vbNewLine & "< w:charset w:val=""02""/>" & vbNewLine & "< w:family w:val=""roman""/>" & vbNewLine & "< w:pitch w:val=""variable""/>" & vbNewLine & "< w:sig w:usb0=""00000000"" w:usb1=""10000000"" w:usb2=""00000000"" w:usb3=""00000000"" w:csb0=""80000000"" w:csb1=""00000000""/>" & vbNewLine & "< /w:font>" & vbNewLine & "< w:font w:name=""Calibri"">" & vbNewLine & "< w:panose1 w:val=""020F0502020204030204""/>" & vbNewLine & "< w:charset w:val=""00""/>" & vbNewLine & "< w:family w:val=""swiss""/>" & vbNewLine & "< w:pitch w:val=""variable""/>" & vbNewLine & "< w:sig w:usb0=""E0002AFF"" w:usb1=""C000247B"" w:usb2=""00000009"" w:usb3=""00000000"" w:csb0=""000001FF"" w:csb1=""00000000""/>" & vbNewLine & "< /w:font>" & vbNewLine & "< w:font w:name=""Arial"">" & vbNewLine & _
"< w:panose1 w:val=""020B0604020202020204""/>" & vbNewLine & "< w:charset w:val=""00""/>" & vbNewLine & "< w:family w:val=""swiss""/>" & vbNewLine & "< w:pitch w:val=""variable""/>" & vbNewLine & "< w:sig w:usb0=""E0002EFF"" w:usb1=""C0007843"" w:usb2=""00000009"" w:usb3=""00000000"" w:csb0=""000001FF"" w:csb1=""00000000""/>" & vbNewLine & "< /w:font>" & vbNewLine & "< w:font w:name=""Calibri Light"">" & vbNewLine & "< w:panose1 w:val=""020F0302020204030204""/>" & vbNewLine & "< w:charset w:val=""00""/>" & vbNewLine & "< w:family w:val=""swiss""/>" & vbNewLine & "< w:pitch w:val=""variable""/>" & vbNewLine & "< w:sig w:usb0=""E0002AFF"" w:usb1=""C000247B"" w:usb2=""00000009"" w:usb3=""00000000"" w:csb0=""000001FF"" w:csb1=""00000000""/>" & vbNewLine & "< /w:font>" & vbNewLine & "< /w:fonts>"
Call ToFile(fontTablexml, WordFolderPath, "fontTable", "xml")
fontTablexml = ""
'Add settings
settingsxml = ""
settingsxml = settingsxml & "< ?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" & vbNewLine & _
"< w:settings xmlns:mc=""http://schemas.openxmlformats.org/markup-compatibility/2006"" xmlns:o=""urn:schemas-microsoft-com:office:office"" xmlns:r=""http://schemas.openxmlformats.org/officeDocument/2006/relationships"" xmlns:m=""http://schemas.openxmlformats.org/officeDocument/2006/math"" xmlns:v=""urn:schemas-microsoft-com:vml"" xmlns:w10=""urn:schemas-microsoft-com:office:word"" xmlns:w=""http://schemas.openxmlformats.org/wordprocessingml/2006/main"" xmlns:w14=""http://schemas.microsoft.com/office/word/2010/wordml"" xmlns:w15=""http://schemas.microsoft.com/office/word/2012/wordml"" xmlns:w16cid=""http://schemas.microsoft.com/office/word/2016/wordml/cid"" xmlns:w16se=""http://schemas.microsoft.com/office/word/2015/wordml/symex"" xmlns:sl=""http://schemas.openxmlformats.org/schemaLibrary/2006/main"" mc:Ignorable=""w14 w15 w16se w16cid"">" & vbNewLine & _
"< w:zoom w:percent=""100""/>" & vbNewLine & "< w:proofState w:spelling=""clean"" w:grammar=""clean""/>" & vbNewLine & "< w:defaultTabStop w:val=""720""/>" & vbNewLine & "< w:characterSpacingControl w:val=""doNotCompress""/>" & vbNewLine & "< w:compat>" & vbNewLine & "< w:compatSetting w:name=""compatibilityMode"" w:uri=""http://schemas.microsoft.com/office/word"" w:val=""15""/>" & vbNewLine & "< w:compatSetting w:name=""overrideTableStyleFontSizeAndJustification"" w:uri=""http://schemas.microsoft.com/office/word"" w:val=""1""/>" & vbNewLine & "< w:compatSetting w:name=""enableOpenTypeFeatures"" w:uri=""http://schemas.microsoft.com/office/word"" w:val=""1""/>" & vbNewLine & "< w:compatSetting w:name=""doNotFlipMirrorIndents"" w:uri=""http://schemas.microsoft.com/office/word"" w:val=""1""/>" & vbNewLine & "< w:compatSetting w:name=""differentiateMultirowTableHeaders"" w:uri=""http://schemas.microsoft.com/office/word"" w:val=""1""/>" & vbNewLine & _
"< w:compatSetting w:name=""useWord2013TrackBottomHyphenation"" w:uri=""http://schemas.microsoft.com/office/word"" w:val=""0""/>" & vbNewLine & "< /w:compat>" & vbNewLine & "< w:rsids>" & vbNewLine & "< w:rsidRoot w:val=""00DE0DF0""/>" & vbNewLine & "< w:rsid w:val=""00301648""/>" & vbNewLine & "< w:rsid w:val=""00484BF0""/>" & vbNewLine & "< w:rsid w:val=""005A2AEB""/>" & vbNewLine & "< w:rsid w:val=""005F1726""/>" & vbNewLine & "< w:rsid w:val=""00661DC2""/>" & vbNewLine & "< w:rsid w:val=""00764C56""/>" & vbNewLine & "< w:rsid w:val=""00DE0DF0""/>" & vbNewLine & "< w:rsid w:val=""00DE7577""/>" & vbNewLine & "< w:rsid w:val=""00FE1981""/>" & vbNewLine & "< /w:rsids>" & vbNewLine & "< m:mathPr>" & vbNewLine & "< m:mathFont m:val=""Cambria Math""/>" & vbNewLine & "< m:brkBin m:val=""before""/>" & vbNewLine & "< m:brkBinSub m:val=""--""/>" & vbNewLine & "< m:smallFrac m:val=""0""/>" & vbNewLine & _
"< m:dispDef/>" & vbNewLine & "< m:lMargin m:val=""0""/>" & vbNewLine & "< m:rMargin m:val=""0""/>" & vbNewLine & "< m:defJc m:val=""centerGroup""/>" & vbNewLine & "< m:wrapIndent m:val=""1440""/>" & vbNewLine & "< m:intLim m:val=""subSup""/>" & vbNewLine & "< m:naryLim m:val=""undOvr""/>" & vbNewLine & "< /m:mathPr>" & vbNewLine & "< w:themeFontLang w:val=""en-US"" w:eastAsia=""en-US"" w:bidi=""ar-SA""/>" & vbNewLine & "< w:clrSchemeMapping w:bg1=""light1"" w:t1=""dark1"" w:bg2=""light2"" w:t2=""dark2"" w:accent1=""accent1"" w:accent2=""accent2"" w:accent3=""accent3"" w:accent4=""accent4"" w:accent5=""accent5"" w:accent6=""accent6"" w:hyperlink=""hyperlink"" w:followedHyperlink=""followedHyperlink""/>" & vbNewLine & "< w:shapeDefaults>" & vbNewLine & "< o:shapedefaults v:ext=""edit"" spidmax=""1026""/>" & vbNewLine & "< o:shapelayout v:ext=""edit"">" & vbNewLine & _
"< o:idmap v:ext=""edit"" data=""1""/>" & vbNewLine & "< /o:shapelayout>" & vbNewLine & "< /w:shapeDefaults>" & vbNewLine & "< w:decimalSymbol w:val="".""/>" & vbNewLine & "< w:listSeparator w:val="",""/>" & vbNewLine & "< w14:docId w14:val=""0C711182""/>" & vbNewLine & "< w15:chartTrackingRefBased/>" & vbNewLine & "< w15:docId w15:val=""{CEA088DD-EE39-4C73-86C2-1B9DD61319E8}""/>" & vbNewLine & "< /w:settings>"
Call ToFile(settingsxml, WordFolderPath, "settings", "xml")
settingsxml = ""
'Add webSettings
webSettingsxml = ""
webSettingsxml = webSettingsxml & "< ?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" & vbNewLine & _
"< w:webSettings xmlns:mc=""http://schemas.openxmlformats.org/markup-compatibility/2006"" xmlns:r=""http://schemas.openxmlformats.org/officeDocument/2006/relationships"" xmlns:w=""http://schemas.openxmlformats.org/wordprocessingml/2006/main"" xmlns:w14=""http://schemas.microsoft.com/office/word/2010/wordml"" xmlns:w15=""http://schemas.microsoft.com/office/word/2012/wordml"" xmlns:w16cid=""http://schemas.microsoft.com/office/word/2016/wordml/cid"" xmlns:w16se=""http://schemas.microsoft.com/office/word/2015/wordml/symex"" mc:Ignorable=""w14 w15 w16se w16cid"">" & vbNewLine & "< w:optimizeForBrowser/>" & vbNewLine & "< w:allowPNG/>" & vbNewLine & "< /w:webSettings>"
Call ToFile(webSettingsxml, WordFolderPath, "webSettings", "xml")
webSettingsxml = ""
'Add webSettings
stylesxml = ""
stylesxml = stylesxml & "< ?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" & vbNewLine & _
"< w:styles xmlns:mc=""http://schemas.openxmlformats.org/markup-compatibility/2006"" xmlns:r=""http://schemas.openxmlformats.org/officeDocument/2006/relationships"" xmlns:w=""http://schemas.openxmlformats.org/wordprocessingml/2006/main"" xmlns:w14=""http://schemas.microsoft.com/office/word/2010/wordml"" xmlns:w15=""http://schemas.microsoft.com/office/word/2012/wordml"" xmlns:w16cid=""http://schemas.microsoft.com/office/word/2016/wordml/cid"" xmlns:w16se=""http://schemas.microsoft.com/office/word/2015/wordml/symex"" mc:Ignorable=""w14 w15 w16se w16cid"">" & vbNewLine & "< w:docDefaults>" & vbNewLine & "< w:rPrDefault>" & vbNewLine & "< w:rPr>" & vbNewLine & "< w:rFonts w:asciiTheme=""minorHAnsi"" w:eastAsiaTheme=""minorHAnsi"" w:hAnsiTheme=""minorHAnsi"" w:cstheme=""minorBidi""/>" & vbNewLine & _
"< w:sz w:val=""22""/>" & vbNewLine & "< w:szCs w:val=""22""/>" & vbNewLine & "< w:lang w:val=""en-US"" w:eastAsia=""en-US"" w:bidi=""ar-SA""/>" & vbNewLine & "< /w:rPr>" & vbNewLine & "< /w:rPrDefault>" & vbNewLine & "< w:pPrDefault>" & vbNewLine & "< w:pPr>" & vbNewLine & "< w:spacing w:after=""160"" w:line=""259"" w:lineRule=""auto""/>" & vbNewLine & "< /w:pPr>" & vbNewLine & "< /w:pPrDefault>" & vbNewLine & "< /w:docDefaults>" & vbNewLine & "< w:latentStyles w:defLockedState=""0"" w:defUIPriority=""99"" w:defSemiHidden=""0"" w:defUnhideWhenUsed=""0"" w:defQFormat=""0"" w:count=""375"">" & vbNewLine & "< w:lsdException w:name=""Normal"" w:uiPriority=""0"" w:qFormat=""1""/>" & vbNewLine & "< w:lsdException w:name=""heading 1"" w:uiPriority=""9"" w:qFormat=""1""/>" & vbNewLine & "< w:lsdException w:name=""heading 2"" w:semiHidden=""1"" w:uiPriority=""9"" w:unhideWhenUsed=""1"" w:qFormat=""1""/>" & vbNewLine & _
"< w:lsdException w:name=""heading 3"" w:semiHidden=""1"" w:uiPriority=""9"" w:unhideWhenUsed=""1"" w:qFormat=""1""/>" & vbNewLine & "< w:lsdException w:name=""heading 4"" w:semiHidden=""1"" w:uiPriority=""9"" w:unhideWhenUsed=""1"" w:qFormat=""1""/>" & vbNewLine & "< w:lsdException w:name=""heading 5"" w:semiHidden=""1"" w:uiPriority=""9"" w:unhideWhenUsed=""1"" w:qFormat=""1""/>" & vbNewLine & "< w:lsdException w:name=""heading 6"" w:semiHidden=""1"" w:uiPriority=""9"" w:unhideWhenUsed=""1"" w:qFormat=""1""/>" & vbNewLine & "< w:lsdException w:name=""heading 7"" w:semiHidden=""1"" w:uiPriority=""9"" w:unhideWhenUsed=""1"" w:qFormat=""1""/>" & vbNewLine & "< w:lsdException w:name=""heading 8"" w:semiHidden=""1"" w:uiPriority=""9"" w:unhideWhenUsed=""1"" w:qFormat=""1""/>" & vbNewLine & "< w:lsdException w:name=""heading 9"" w:semiHidden=""1"" w:uiPriority=""9"" w:unhideWhenUsed=""1"" w:qFormat=""1""/>" & vbNewLine & _
"< w:lsdException w:name=""index 1"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""index 2"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""index 3"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""index 4"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""index 5"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""index 6"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""index 7"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""index 8"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""index 9"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & _
"< w:lsdException w:name=""toc 1"" w:semiHidden=""1"" w:uiPriority=""39"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""toc 2"" w:semiHidden=""1"" w:uiPriority=""39"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""toc 3"" w:semiHidden=""1"" w:uiPriority=""39"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""toc 4"" w:semiHidden=""1"" w:uiPriority=""39"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""toc 5"" w:semiHidden=""1"" w:uiPriority=""39"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""toc 6"" w:semiHidden=""1"" w:uiPriority=""39"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""toc 7"" w:semiHidden=""1"" w:uiPriority=""39"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""toc 8"" w:semiHidden=""1"" w:uiPriority=""39"" w:unhideWhenUsed=""1""/>" & vbNewLine & _
"< w:lsdException w:name=""toc 9"" w:semiHidden=""1"" w:uiPriority=""39"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Normal Indent"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""footnote text"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""annotation text"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""header"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""footer"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""index heading"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""caption"" w:semiHidden=""1"" w:uiPriority=""35"" w:unhideWhenUsed=""1"" w:qFormat=""1""/>" & vbNewLine & "< w:lsdException w:name=""table of figures"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & _
"< w:lsdException w:name=""envelope address"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""envelope return"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""footnote reference"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""annotation reference"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""line number"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""page number"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""endnote reference"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""endnote text"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""table of authorities"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & _
"< w:lsdException w:name=""macro"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""toa heading"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""List"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""List Bullet"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""List Number"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""List 2"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""List 3"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""List 4"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""List 5"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & _
"< w:lsdException w:name=""List Bullet 2"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""List Bullet 3"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""List Bullet 4"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""List Bullet 5"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""List Number 2"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""List Number 3"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""List Number 4"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""List Number 5"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Title"" w:uiPriority=""10"" w:qFormat=""1""/>" & vbNewLine & _
"< w:lsdException w:name=""Closing"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Signature"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Default Paragraph Font"" w:semiHidden=""1"" w:uiPriority=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Body Text"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Body Text Indent"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""List Continue"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""List Continue 2"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""List Continue 3"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""List Continue 4"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & _
"< w:lsdException w:name=""List Continue 5"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Message Header"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Subtitle"" w:uiPriority=""11"" w:qFormat=""1""/>" & vbNewLine & "< w:lsdException w:name=""Salutation"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Date"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Body Text First Indent"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Body Text First Indent 2"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Note Heading"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Body Text 2"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & _
"< w:lsdException w:name=""Body Text 3"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Body Text Indent 2"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Body Text Indent 3"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Block Text"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Hyperlink"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""FollowedHyperlink"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Strong"" w:uiPriority=""22"" w:qFormat=""1""/>" & vbNewLine & "< w:lsdException w:name=""Emphasis"" w:uiPriority=""20"" w:qFormat=""1""/>" & vbNewLine & "< w:lsdException w:name=""Document Map"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & _
"< w:lsdException w:name=""Plain Text"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""E-mail Signature"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""HTML Top of Form"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""HTML Bottom of Form"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Normal (Web)"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""HTML Acronym"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""HTML Address"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""HTML Cite"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""HTML Code"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & _
"< w:lsdException w:name=""HTML Definition"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""HTML Keyboard"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""HTML Preformatted"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""HTML Sample"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""HTML Typewriter"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""HTML Variable"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Normal Table"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""annotation subject"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""No List"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine
stylesxml = stylesxml & "< w:lsdException w:name=""Outline List 1"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Outline List 2"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Outline List 3"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Simple 1"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Simple 2"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Simple 3"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Classic 1"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Classic 2"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Classic 3"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & _
"< w:lsdException w:name=""Table Classic 4"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Colorful 1"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Colorful 2"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Colorful 3"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Columns 1"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Columns 2"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Columns 3"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Columns 4"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Columns 5"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & _
"< w:lsdException w:name=""Table Grid 1"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Grid 2"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Grid 3"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Grid 4"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Grid 5"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Grid 6"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Grid 7"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Grid 8"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table List 1"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & _
"< w:lsdException w:name=""Table List 2"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table List 3"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table List 4"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table List 5"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table List 6"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table List 7"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table List 8"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table 3D effects 1"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table 3D effects 2"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & _
"< w:lsdException w:name=""Table 3D effects 3"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Contemporary"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Elegant"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Professional"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Subtle 1"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Subtle 2"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Web 1"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Web 2"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Web 3"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & _
"< w:lsdException w:name=""Balloon Text"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Table Grid"" w:uiPriority=""39""/>" & vbNewLine & "< w:lsdException w:name=""Table Theme"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Placeholder Text"" w:semiHidden=""1""/>" & vbNewLine & "< w:lsdException w:name=""No Spacing"" w:uiPriority=""1"" w:qFormat=""1""/>" & vbNewLine & "< w:lsdException w:name=""Light Shading"" w:uiPriority=""60""/>" & vbNewLine & "< w:lsdException w:name=""Light List"" w:uiPriority=""61""/>" & vbNewLine & "< w:lsdException w:name=""Light Grid"" w:uiPriority=""62""/>" & vbNewLine & "< w:lsdException w:name=""Medium Shading 1"" w:uiPriority=""63""/>" & vbNewLine & "< w:lsdException w:name=""Medium Shading 2"" w:uiPriority=""64""/>" & vbNewLine & "< w:lsdException w:name=""Medium List 1"" w:uiPriority=""65""/>" & vbNewLine & _
"< w:lsdException w:name=""Medium List 2"" w:uiPriority=""66""/>" & vbNewLine & "< w:lsdException w:name=""Medium Grid 1"" w:uiPriority=""67""/>" & vbNewLine & "< w:lsdException w:name=""Medium Grid 2"" w:uiPriority=""68""/>" & vbNewLine & "< w:lsdException w:name=""Medium Grid 3"" w:uiPriority=""69""/>" & vbNewLine & "< w:lsdException w:name=""Dark List"" w:uiPriority=""70""/>" & vbNewLine & "< w:lsdException w:name=""Colorful Shading"" w:uiPriority=""71""/>" & vbNewLine & "< w:lsdException w:name=""Colorful List"" w:uiPriority=""72""/>" & vbNewLine & "< w:lsdException w:name=""Colorful Grid"" w:uiPriority=""73""/>" & vbNewLine & "< w:lsdException w:name=""Light Shading Accent 1"" w:uiPriority=""60""/>" & vbNewLine & "< w:lsdException w:name=""Light List Accent 1"" w:uiPriority=""61""/>" & vbNewLine & "< w:lsdException w:name=""Light Grid Accent 1"" w:uiPriority=""62""/>" & vbNewLine & _
"< w:lsdException w:name=""Medium Shading 1 Accent 1"" w:uiPriority=""63""/>" & vbNewLine & "< w:lsdException w:name=""Medium Shading 2 Accent 1"" w:uiPriority=""64""/>" & vbNewLine & "< w:lsdException w:name=""Medium List 1 Accent 1"" w:uiPriority=""65""/>" & vbNewLine & "< w:lsdException w:name=""Revision"" w:semiHidden=""1""/>" & vbNewLine & "< w:lsdException w:name=""List Paragraph"" w:uiPriority=""34"" w:qFormat=""1""/>" & vbNewLine & "< w:lsdException w:name=""Quote"" w:uiPriority=""29"" w:qFormat=""1""/>" & vbNewLine & "< w:lsdException w:name=""Intense Quote"" w:uiPriority=""30"" w:qFormat=""1""/>" & vbNewLine & "< w:lsdException w:name=""Medium List 2 Accent 1"" w:uiPriority=""66""/>" & vbNewLine & "< w:lsdException w:name=""Medium Grid 1 Accent 1"" w:uiPriority=""67""/>" & vbNewLine & "< w:lsdException w:name=""Medium Grid 2 Accent 1"" w:uiPriority=""68""/>" & vbNewLine & _
"< w:lsdException w:name=""Medium Grid 3 Accent 1"" w:uiPriority=""69""/>" & vbNewLine & "< w:lsdException w:name=""Dark List Accent 1"" w:uiPriority=""70""/>" & vbNewLine & "< w:lsdException w:name=""Colorful Shading Accent 1"" w:uiPriority=""71""/>" & vbNewLine & "< w:lsdException w:name=""Colorful List Accent 1"" w:uiPriority=""72""/>" & vbNewLine & "< w:lsdException w:name=""Colorful Grid Accent 1"" w:uiPriority=""73""/>" & vbNewLine & "< w:lsdException w:name=""Light Shading Accent 2"" w:uiPriority=""60""/>" & vbNewLine & "< w:lsdException w:name=""Light List Accent 2"" w:uiPriority=""61""/>" & vbNewLine & "< w:lsdException w:name=""Light Grid Accent 2"" w:uiPriority=""62""/>" & vbNewLine & "< w:lsdException w:name=""Medium Shading 1 Accent 2"" w:uiPriority=""63""/>" & vbNewLine & "< w:lsdException w:name=""Medium Shading 2 Accent 2"" w:uiPriority=""64""/>" & vbNewLine & _
"< w:lsdException w:name=""Medium List 1 Accent 2"" w:uiPriority=""65""/>" & vbNewLine & "< w:lsdException w:name=""Medium List 2 Accent 2"" w:uiPriority=""66""/>" & vbNewLine & "< w:lsdException w:name=""Medium Grid 1 Accent 2"" w:uiPriority=""67""/>" & vbNewLine & "< w:lsdException w:name=""Medium Grid 2 Accent 2"" w:uiPriority=""68""/>" & vbNewLine & "< w:lsdException w:name=""Medium Grid 3 Accent 2"" w:uiPriority=""69""/>" & vbNewLine & "< w:lsdException w:name=""Dark List Accent 2"" w:uiPriority=""70""/>" & vbNewLine & "< w:lsdException w:name=""Colorful Shading Accent 2"" w:uiPriority=""71""/>" & vbNewLine & "< w:lsdException w:name=""Colorful List Accent 2"" w:uiPriority=""72""/>" & vbNewLine & "< w:lsdException w:name=""Colorful Grid Accent 2"" w:uiPriority=""73""/>" & vbNewLine & "< w:lsdException w:name=""Light Shading Accent 3"" w:uiPriority=""60""/>" & vbNewLine & _
"< w:lsdException w:name=""Light List Accent 3"" w:uiPriority=""61""/>" & vbNewLine & "< w:lsdException w:name=""Light Grid Accent 3"" w:uiPriority=""62""/>" & vbNewLine & "< w:lsdException w:name=""Medium Shading 1 Accent 3"" w:uiPriority=""63""/>" & vbNewLine & "< w:lsdException w:name=""Medium Shading 2 Accent 3"" w:uiPriority=""64""/>" & vbNewLine & "< w:lsdException w:name=""Medium List 1 Accent 3"" w:uiPriority=""65""/>" & vbNewLine & "< w:lsdException w:name=""Medium List 2 Accent 3"" w:uiPriority=""66""/>" & vbNewLine & "< w:lsdException w:name=""Medium Grid 1 Accent 3"" w:uiPriority=""67""/>" & vbNewLine & "< w:lsdException w:name=""Medium Grid 2 Accent 3"" w:uiPriority=""68""/>" & vbNewLine & "< w:lsdException w:name=""Medium Grid 3 Accent 3"" w:uiPriority=""69""/>" & vbNewLine & "< w:lsdException w:name=""Dark List Accent 3"" w:uiPriority=""70""/>" & vbNewLine & _
"< w:lsdException w:name=""Colorful Shading Accent 3"" w:uiPriority=""71""/>" & vbNewLine & "< w:lsdException w:name=""Colorful List Accent 3"" w:uiPriority=""72""/>" & vbNewLine & "< w:lsdException w:name=""Colorful Grid Accent 3"" w:uiPriority=""73""/>" & vbNewLine & "< w:lsdException w:name=""Light Shading Accent 4"" w:uiPriority=""60""/>" & vbNewLine & "< w:lsdException w:name=""Light List Accent 4"" w:uiPriority=""61""/>" & vbNewLine & "< w:lsdException w:name=""Light Grid Accent 4"" w:uiPriority=""62""/>" & vbNewLine & "< w:lsdException w:name=""Medium Shading 1 Accent 4"" w:uiPriority=""63""/>" & vbNewLine & "< w:lsdException w:name=""Medium Shading 2 Accent 4"" w:uiPriority=""64""/>" & vbNewLine & "< w:lsdException w:name=""Medium List 1 Accent 4"" w:uiPriority=""65""/>" & vbNewLine & "< w:lsdException w:name=""Medium List 2 Accent 4"" w:uiPriority=""66""/>" & vbNewLine & _
"< w:lsdException w:name=""Medium Grid 1 Accent 4"" w:uiPriority=""67""/>" & vbNewLine & "< w:lsdException w:name=""Medium Grid 2 Accent 4"" w:uiPriority=""68""/>" & vbNewLine & "< w:lsdException w:name=""Medium Grid 3 Accent 4"" w:uiPriority=""69""/>" & vbNewLine & "< w:lsdException w:name=""Dark List Accent 4"" w:uiPriority=""70""/>" & vbNewLine & "< w:lsdException w:name=""Colorful Shading Accent 4"" w:uiPriority=""71""/>" & vbNewLine & "< w:lsdException w:name=""Colorful List Accent 4"" w:uiPriority=""72""/>" & vbNewLine & "< w:lsdException w:name=""Colorful Grid Accent 4"" w:uiPriority=""73""/>" & vbNewLine & "< w:lsdException w:name=""Light Shading Accent 5"" w:uiPriority=""60""/>" & vbNewLine & "< w:lsdException w:name=""Light List Accent 5"" w:uiPriority=""61""/>" & vbNewLine & "< w:lsdException w:name=""Light Grid Accent 5"" w:uiPriority=""62""/>" & vbNewLine & _
"< w:lsdException w:name=""Medium Shading 1 Accent 5"" w:uiPriority=""63""/>" & vbNewLine & "< w:lsdException w:name=""Medium Shading 2 Accent 5"" w:uiPriority=""64""/>" & vbNewLine & "< w:lsdException w:name=""Medium List 1 Accent 5"" w:uiPriority=""65""/>" & vbNewLine & "< w:lsdException w:name=""Medium List 2 Accent 5"" w:uiPriority=""66""/>" & vbNewLine & "< w:lsdException w:name=""Medium Grid 1 Accent 5"" w:uiPriority=""67""/>" & vbNewLine & "< w:lsdException w:name=""Medium Grid 2 Accent 5"" w:uiPriority=""68""/>" & vbNewLine & "< w:lsdException w:name=""Medium Grid 3 Accent 5"" w:uiPriority=""69""/>" & vbNewLine & "< w:lsdException w:name=""Dark List Accent 5"" w:uiPriority=""70""/>" & vbNewLine & "< w:lsdException w:name=""Colorful Shading Accent 5"" w:uiPriority=""71""/>" & vbNewLine & "< w:lsdException w:name=""Colorful List Accent 5"" w:uiPriority=""72""/>" & vbNewLine & _
"< w:lsdException w:name=""Colorful Grid Accent 5"" w:uiPriority=""73""/>" & vbNewLine & "< w:lsdException w:name=""Light Shading Accent 6"" w:uiPriority=""60""/>" & vbNewLine & "< w:lsdException w:name=""Light List Accent 6"" w:uiPriority=""61""/>" & vbNewLine & "< w:lsdException w:name=""Light Grid Accent 6"" w:uiPriority=""62""/>" & vbNewLine & "< w:lsdException w:name=""Medium Shading 1 Accent 6"" w:uiPriority=""63""/>" & vbNewLine & "< w:lsdException w:name=""Medium Shading 2 Accent 6"" w:uiPriority=""64""/>" & vbNewLine & "< w:lsdException w:name=""Medium List 1 Accent 6"" w:uiPriority=""65""/>" & vbNewLine & "< w:lsdException w:name=""Medium List 2 Accent 6"" w:uiPriority=""66""/>" & vbNewLine & "< w:lsdException w:name=""Medium Grid 1 Accent 6"" w:uiPriority=""67""/>" & vbNewLine & "< w:lsdException w:name=""Medium Grid 2 Accent 6"" w:uiPriority=""68""/>" & vbNewLine
stylesxml = stylesxml & "< w:lsdException w:name=""Medium Grid 3 Accent 6"" w:uiPriority=""69""/>" & vbNewLine & "< w:lsdException w:name=""Dark List Accent 6"" w:uiPriority=""70""/>" & vbNewLine & "< w:lsdException w:name=""Colorful Shading Accent 6"" w:uiPriority=""71""/>" & vbNewLine & "< w:lsdException w:name=""Colorful List Accent 6"" w:uiPriority=""72""/>" & vbNewLine & "< w:lsdException w:name=""Colorful Grid Accent 6"" w:uiPriority=""73""/>" & vbNewLine & "< w:lsdException w:name=""Subtle Emphasis"" w:uiPriority=""19"" w:qFormat=""1""/>" & vbNewLine & "< w:lsdException w:name=""Intense Emphasis"" w:uiPriority=""21"" w:qFormat=""1""/>" & vbNewLine & "< w:lsdException w:name=""Subtle Reference"" w:uiPriority=""31"" w:qFormat=""1""/>" & vbNewLine & "< w:lsdException w:name=""Intense Reference"" w:uiPriority=""32"" w:qFormat=""1""/>" & vbNewLine & "< w:lsdException w:name=""Book Title"" w:uiPriority=""33"" w:qFormat=""1""/>" & vbNewLine & _
"< w:lsdException w:name=""Bibliography"" w:semiHidden=""1"" w:uiPriority=""37"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""TOC Heading"" w:semiHidden=""1"" w:uiPriority=""39"" w:unhideWhenUsed=""1"" w:qFormat=""1""/>" & vbNewLine & "< w:lsdException w:name=""Plain Table 1"" w:uiPriority=""41""/>" & vbNewLine & "< w:lsdException w:name=""Plain Table 2"" w:uiPriority=""42""/>" & vbNewLine & "< w:lsdException w:name=""Plain Table 3"" w:uiPriority=""43""/>" & vbNewLine & "< w:lsdException w:name=""Plain Table 4"" w:uiPriority=""44""/>" & vbNewLine & "< w:lsdException w:name=""Plain Table 5"" w:uiPriority=""45""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table Light"" w:uiPriority=""40""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 1 Light"" w:uiPriority=""46""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 2"" w:uiPriority=""47""/>" & vbNewLine & _
"< w:lsdException w:name=""Grid Table 3"" w:uiPriority=""48""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 4"" w:uiPriority=""49""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 5 Dark"" w:uiPriority=""50""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 6 Colorful"" w:uiPriority=""51""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 7 Colorful"" w:uiPriority=""52""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 1 Light Accent 1"" w:uiPriority=""46""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 2 Accent 1"" w:uiPriority=""47""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 3 Accent 1"" w:uiPriority=""48""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 4 Accent 1"" w:uiPriority=""49""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 5 Dark Accent 1"" w:uiPriority=""50""/>" & vbNewLine & _
"< w:lsdException w:name=""Grid Table 6 Colorful Accent 1"" w:uiPriority=""51""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 7 Colorful Accent 1"" w:uiPriority=""52""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 1 Light Accent 2"" w:uiPriority=""46""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 2 Accent 2"" w:uiPriority=""47""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 3 Accent 2"" w:uiPriority=""48""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 4 Accent 2"" w:uiPriority=""49""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 5 Dark Accent 2"" w:uiPriority=""50""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 6 Colorful Accent 2"" w:uiPriority=""51""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 7 Colorful Accent 2"" w:uiPriority=""52""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 1 Light Accent 3"" w:uiPriority=""46""/>" & vbNewLine & _
"< w:lsdException w:name=""Grid Table 2 Accent 3"" w:uiPriority=""47""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 3 Accent 3"" w:uiPriority=""48""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 4 Accent 3"" w:uiPriority=""49""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 5 Dark Accent 3"" w:uiPriority=""50""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 6 Colorful Accent 3"" w:uiPriority=""51""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 7 Colorful Accent 3"" w:uiPriority=""52""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 1 Light Accent 4"" w:uiPriority=""46""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 2 Accent 4"" w:uiPriority=""47""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 3 Accent 4"" w:uiPriority=""48""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 4 Accent 4"" w:uiPriority=""49""/>" & vbNewLine & _
"< w:lsdException w:name=""Grid Table 5 Dark Accent 4"" w:uiPriority=""50""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 6 Colorful Accent 4"" w:uiPriority=""51""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 7 Colorful Accent 4"" w:uiPriority=""52""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 1 Light Accent 5"" w:uiPriority=""46""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 2 Accent 5"" w:uiPriority=""47""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 3 Accent 5"" w:uiPriority=""48""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 4 Accent 5"" w:uiPriority=""49""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 5 Dark Accent 5"" w:uiPriority=""50""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 6 Colorful Accent 5"" w:uiPriority=""51""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 7 Colorful Accent 5"" w:uiPriority=""52""/>" & vbNewLine & _
"< w:lsdException w:name=""Grid Table 1 Light Accent 6"" w:uiPriority=""46""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 2 Accent 6"" w:uiPriority=""47""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 3 Accent 6"" w:uiPriority=""48""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 4 Accent 6"" w:uiPriority=""49""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 5 Dark Accent 6"" w:uiPriority=""50""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 6 Colorful Accent 6"" w:uiPriority=""51""/>" & vbNewLine & "< w:lsdException w:name=""Grid Table 7 Colorful Accent 6"" w:uiPriority=""52""/>" & vbNewLine & "< w:lsdException w:name=""List Table 1 Light"" w:uiPriority=""46""/>" & vbNewLine & "< w:lsdException w:name=""List Table 2"" w:uiPriority=""47""/>" & vbNewLine & "< w:lsdException w:name=""List Table 3"" w:uiPriority=""48""/>" & vbNewLine & _
"< w:lsdException w:name=""List Table 4"" w:uiPriority=""49""/>" & vbNewLine & "< w:lsdException w:name=""List Table 5 Dark"" w:uiPriority=""50""/>" & vbNewLine & "< w:lsdException w:name=""List Table 6 Colorful"" w:uiPriority=""51""/>" & vbNewLine & "< w:lsdException w:name=""List Table 7 Colorful"" w:uiPriority=""52""/>" & vbNewLine & "< w:lsdException w:name=""List Table 1 Light Accent 1"" w:uiPriority=""46""/>" & vbNewLine & "< w:lsdException w:name=""List Table 2 Accent 1"" w:uiPriority=""47""/>" & vbNewLine & "< w:lsdException w:name=""List Table 3 Accent 1"" w:uiPriority=""48""/>" & vbNewLine & "< w:lsdException w:name=""List Table 4 Accent 1"" w:uiPriority=""49""/>" & vbNewLine & "< w:lsdException w:name=""List Table 5 Dark Accent 1"" w:uiPriority=""50""/>" & vbNewLine & "< w:lsdException w:name=""List Table 6 Colorful Accent 1"" w:uiPriority=""51""/>" & vbNewLine & _
"< w:lsdException w:name=""List Table 7 Colorful Accent 1"" w:uiPriority=""52""/>" & vbNewLine & "< w:lsdException w:name=""List Table 1 Light Accent 2"" w:uiPriority=""46""/>" & vbNewLine & "< w:lsdException w:name=""List Table 2 Accent 2"" w:uiPriority=""47""/>" & vbNewLine & "< w:lsdException w:name=""List Table 3 Accent 2"" w:uiPriority=""48""/>" & vbNewLine & "< w:lsdException w:name=""List Table 4 Accent 2"" w:uiPriority=""49""/>" & vbNewLine & "< w:lsdException w:name=""List Table 5 Dark Accent 2"" w:uiPriority=""50""/>" & vbNewLine & "< w:lsdException w:name=""List Table 6 Colorful Accent 2"" w:uiPriority=""51""/>" & vbNewLine & "< w:lsdException w:name=""List Table 7 Colorful Accent 2"" w:uiPriority=""52""/>" & vbNewLine & "< w:lsdException w:name=""List Table 1 Light Accent 3"" w:uiPriority=""46""/>" & vbNewLine & "< w:lsdException w:name=""List Table 2 Accent 3"" w:uiPriority=""47""/>" & vbNewLine & _
"< w:lsdException w:name=""List Table 3 Accent 3"" w:uiPriority=""48""/>" & vbNewLine & "< w:lsdException w:name=""List Table 4 Accent 3"" w:uiPriority=""49""/>" & vbNewLine & "< w:lsdException w:name=""List Table 5 Dark Accent 3"" w:uiPriority=""50""/>" & vbNewLine & "< w:lsdException w:name=""List Table 6 Colorful Accent 3"" w:uiPriority=""51""/>" & vbNewLine & "< w:lsdException w:name=""List Table 7 Colorful Accent 3"" w:uiPriority=""52""/>" & vbNewLine & "< w:lsdException w:name=""List Table 1 Light Accent 4"" w:uiPriority=""46""/>" & vbNewLine & "< w:lsdException w:name=""List Table 2 Accent 4"" w:uiPriority=""47""/>" & vbNewLine & "< w:lsdException w:name=""List Table 3 Accent 4"" w:uiPriority=""48""/>" & vbNewLine & "< w:lsdException w:name=""List Table 4 Accent 4"" w:uiPriority=""49""/>" & vbNewLine & "< w:lsdException w:name=""List Table 5 Dark Accent 4"" w:uiPriority=""50""/>" & vbNewLine & _
"< w:lsdException w:name=""List Table 6 Colorful Accent 4"" w:uiPriority=""51""/>" & vbNewLine & "< w:lsdException w:name=""List Table 7 Colorful Accent 4"" w:uiPriority=""52""/>" & vbNewLine & "< w:lsdException w:name=""List Table 1 Light Accent 5"" w:uiPriority=""46""/>" & vbNewLine & "< w:lsdException w:name=""List Table 2 Accent 5"" w:uiPriority=""47""/>" & vbNewLine & "< w:lsdException w:name=""List Table 3 Accent 5"" w:uiPriority=""48""/>" & vbNewLine & "< w:lsdException w:name=""List Table 4 Accent 5"" w:uiPriority=""49""/>" & vbNewLine & "< w:lsdException w:name=""List Table 5 Dark Accent 5"" w:uiPriority=""50""/>" & vbNewLine & "< w:lsdException w:name=""List Table 6 Colorful Accent 5"" w:uiPriority=""51""/>" & vbNewLine & "< w:lsdException w:name=""List Table 7 Colorful Accent 5"" w:uiPriority=""52""/>" & vbNewLine & "< w:lsdException w:name=""List Table 1 Light Accent 6"" w:uiPriority=""46""/>" & vbNewLine & _
"< w:lsdException w:name=""List Table 2 Accent 6"" w:uiPriority=""47""/>" & vbNewLine & "< w:lsdException w:name=""List Table 3 Accent 6"" w:uiPriority=""48""/>" & vbNewLine & "< w:lsdException w:name=""List Table 4 Accent 6"" w:uiPriority=""49""/>" & vbNewLine & "< w:lsdException w:name=""List Table 5 Dark Accent 6"" w:uiPriority=""50""/>" & vbNewLine & "< w:lsdException w:name=""List Table 6 Colorful Accent 6"" w:uiPriority=""51""/>" & vbNewLine & "< w:lsdException w:name=""List Table 7 Colorful Accent 6"" w:uiPriority=""52""/>" & vbNewLine & "< w:lsdException w:name=""Mention"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Smart Hyperlink"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Hashtag"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & "< w:lsdException w:name=""Unresolved Mention"" w:semiHidden=""1"" w:unhideWhenUsed=""1""/>" & vbNewLine & _
"< /w:latentStyles>" & vbNewLine & "< w:style w:type=""paragraph"" w:default=""1"" w:styleId=""a"">" & vbNewLine & "< w:name w:val=""Normal""/>" & vbNewLine & "< w:qFormat/>" & vbNewLine & "< w:pPr>" & vbNewLine & "< w:bidi/>" & vbNewLine & "< /w:pPr>" & vbNewLine & "< /w:style>" & vbNewLine & "< w:style w:type=""character"" w:default=""1"" w:styleId=""a0"">" & vbNewLine & "< w:name w:val=""Default Paragraph Font""/>" & vbNewLine & "< w:uiPriority w:val=""1""/>" & vbNewLine & "< w:semiHidden/>" & vbNewLine & "< w:unhideWhenUsed/>" & vbNewLine & "< /w:style>" & vbNewLine & "< w:style w:type=""table"" w:default=""1"" w:styleId=""a1"">" & vbNewLine & "< w:name w:val=""Normal Table""/>" & vbNewLine & "< w:uiPriority w:val=""99""/>" & vbNewLine & "< w:semiHidden/>" & vbNewLine & "< w:unhideWhenUsed/>" & vbNewLine & "< w:tblPr>" & vbNewLine & "< w:tblInd w:w=""0"" w:type=""dxa""/>" & vbNewLine & _
"< w:tblCellMar>" & vbNewLine & "< w:top w:w=""0"" w:type=""dxa""/>" & vbNewLine & "< w:left w:w=""108"" w:type=""dxa""/>" & vbNewLine & "< w:bottom w:w=""0"" w:type=""dxa""/>" & vbNewLine & "< w:right w:w=""108"" w:type=""dxa""/>" & vbNewLine & "< /w:tblCellMar>" & vbNewLine & "< /w:tblPr>" & vbNewLine & "< /w:style>" & vbNewLine & "< w:style w:type=""numbering"" w:default=""1"" w:styleId=""a2"">" & vbNewLine & "< w:name w:val=""No List""/>" & vbNewLine & "< w:uiPriority w:val=""99""/>" & vbNewLine & "< w:semiHidden/>" & vbNewLine & "< w:unhideWhenUsed/>" & vbNewLine & "< /w:style>" & vbNewLine & "< w:style w:type=""table"" w:styleId=""a3"">" & vbNewLine & "< w:name w:val=""Table Grid""/>" & vbNewLine & "< w:basedOn w:val=""a1""/>" & vbNewLine & "< w:uiPriority w:val=""39""/>" & vbNewLine & "< w:rsid w:val=""00301648""/>" & vbNewLine & "< w:pPr>" & vbNewLine & _
"< w:spacing w:after=""0"" w:line=""240"" w:lineRule=""auto""/>" & vbNewLine & "< /w:pPr>" & vbNewLine & "< w:tblPr>" & vbNewLine & "< w:tblBorders>" & vbNewLine & "< w:top w:val=""single"" w:sz=""4"" w:space=""0"" w:color=""auto""/>" & vbNewLine & "< w:left w:val=""single"" w:sz=""4"" w:space=""0"" w:color=""auto""/>" & vbNewLine & "< w:bottom w:val=""single"" w:sz=""4"" w:space=""0"" w:color=""auto""/>" & vbNewLine & "< w:right w:val=""single"" w:sz=""4"" w:space=""0"" w:color=""auto""/>" & vbNewLine & "< w:insideH w:val=""single"" w:sz=""4"" w:space=""0"" w:color=""auto""/>" & vbNewLine & "< w:insideV w:val=""single"" w:sz=""4"" w:space=""0"" w:color=""auto""/>" & vbNewLine & "< /w:tblBorders>" & vbNewLine & "< /w:tblPr>" & vbNewLine & "< /w:style>" & vbNewLine & "< w:style w:type=""paragraph"" w:styleId=""a4"">" & vbNewLine & "< w:name w:val=""List Paragraph""/>" & vbNewLine
stylesxml = stylesxml & "< w:basedOn w:val=""a""/>" & vbNewLine & "< w:uiPriority w:val=""34""/>" & vbNewLine & "< w:qFormat/>" & vbNewLine & "< w:rsid w:val=""00301648""/>" & vbNewLine & "< w:pPr>" & vbNewLine & "< w:ind w:left=""720""/>" & vbNewLine & "< w:contextualSpacing/>" & vbNewLine & "< /w:pPr>" & vbNewLine & "< /w:style>" & vbNewLine & "< /w:styles>"
Call ToFile(stylesxml, WordFolderPath, "styles", "xml")
stylesxml = ""
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''' Here Get XML code to Create docx File ''''''''''''''''
documentxml = Split(GetTable(WS, TblRng), "|")(1)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Call ToFile(documentxml, WordFolderPath, "document", "xml")
documentxmlrels = "< ?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" & vbNewLine
documentxmlrels = documentxmlrels & "< Relationships xmlns=""http://schemas.openxmlformats.org/package/2006/relationships"">" & vbNewLine
Set FF = fso.GetFolder(WordFolderPath)
N = 1
For Each SubF In FF.SubFolders
If InStr(1, SubF.Name, "WordFolderPath") <> 0 Then
For Each file In SubF.Files
If InStr(1, file.Name, "document.xml") <> 0 Then
Else
N = N + 1
documentxmlrels = documentxmlrels & "< Relationship Id=""rId""" & N & """ Type=""http://schemas.openxmlformats.org/officeDocument/2006/relationships/" & Split(file.Name, ".")(0) & """ Target=""" & file.Name & """/>" & vbNewLine
End If
Next
End If
Next
For Each file In FF.SubFolders
If InStr(1, file.Name, "document.xml") <> 0 Then
Else
N = N + 1
documentxmlrels = documentxmlrels & "< Relationship Id=""rId""" & N & """ Type=""http://schemas.openxmlformats.org/officeDocument/2006/relationships/" & Split(file.Name, ".")(0) & """ Target=""" & file.Name & """/>" & vbNewLine
End If
Next
documentxmlrels = documentxmlrels & "< /Relationships>"
Set FF = Nothing
documentxmlrels = "< ?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" & vbNewLine & _
"< Relationships xmlns=""http://schemas.openxmlformats.org/package/2006/relationships"">< Relationship Id=""rId3"" Type=""http://schemas.openxmlformats.org/officeDocument/2006/relationships/webSettings"" Target=""webSettings.xml""/>< Relationship Id=""rId2"" Type=""http://schemas.openxmlformats.org/officeDocument/2006/relationships/settings"" Target=""settings.xml""/>< Relationship Id=""rId1"" Type=""http://schemas.openxmlformats.org/officeDocument/2006/relationships/styles"" Target=""styles.xml""/>< Relationship Id=""rId5"" Type=""http://schemas.openxmlformats.org/officeDocument/2006/relationships/theme"" Target=""theme/theme1.xml""/>< Relationship Id=""rId4"" Type=""http://schemas.openxmlformats.org/officeDocument/2006/relationships/fontTable"" Target=""fontTable.xml""/>< /Relationships>"
Call ToFile(documentxmlrels, relsWordFolderPath, "", "document.xml.rels")
rels = "< ?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" & vbNewLine
rels = rels & "< Relationships xmlns=""http://schemas.openxmlformats.org/package/2006/relationships"">"
Set FF = fso.GetFolder(FolderPath)
N = 1
For Each SubF In FF.SubFolders
For Each file In SubF.Files
If SubF.Name = "word" And InStr(1, file.Name, "document.xml") <> 0 Then
N = 1
rels = rels & "< Relationship Id=""rId" & N & """ Type=""http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument"" Target=""" & SubF.Name & "/" & file.Name & """/>"
ElseIf SubF.Name = "docProps" Then
N = N + 1
If InStr(1, file.Name, "core.xml") <> 0 Then
rels = rels & "< Relationship Id=""rId" & N & """ Type=""http://schemas.openxmlformats.org/package/2006/relationships/metadata/" & Split(file.Name, ".")(0) & "-properties"" Target=""" & SubF.Name & "/" & file.Name & """/>"
ElseIf InStr(1, file.Name, "custom.xml") <> 0 Then
rels = rels & "< Relationship Id=""rId" & N & """ Type=""http://schemas.openxmlformats.org/officeDocument/2006/relationships/" & Split(file.Name, ".")(0) & "-properties"" Target=""" & SubF.Name & "/" & file.Name & """/>"
' rels = rels & "< Relationship Id=""rId4"" Type=""http://schemas.openxmlformats.org/officeDocument/2006/relationships/custom-properties"" Target=""docProps/custom.xml""/>"
Else
rels = rels & "< Relationship Id=""rId" & N & """ Type=""http://schemas.openxmlformats.org/officeDocument/2006/relationships/extended-properties"" Target=""" & SubF.Name & "/" & file.Name & """/>"
End If
End If
Next
Next
Set FF = Nothing
rels = rels & "< /Relationships>"
'rels = "< ?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" & vbNewLine & _
"< Relationships xmlns=""http://schemas.openxmlformats.org/package/2006/relationships"">< Relationship Id=""rId3"" Type=""http://schemas.openxmlformats.org/officeDocument/2006/relationships/extended-properties"" Target=""docProps/app.xml""/>< Relationship Id=""rId2"" Type=""http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties"" Target=""docProps/core.xml""/>< Relationship Id=""rId1"" Type=""http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument"" Target=""word/document.xml""/>< /Relationships>"
Call ToFile(rels, relsFolderPath, "", "rels")
Set fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
queue.Add fso.GetFolder(FolderPath) 'obviously replace
Content_Typesxml = "< ?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" & vbNewLine
Content_Typesxml = Content_Typesxml & "< Types xmlns=""http://schemas.openxmlformats.org/package/2006/content-types"">" & vbNewLine & _
"< Default Extension=""rels"" ContentType=""application/vnd.openxmlformats-package.relationships+xml""/>" & vbNewLine & _
"< Default Extension=""xml"" ContentType=""application/xml""/>" & vbNewLine
Do While queue.Count > 0
Set FF = queue(1)
queue.Remove 1 'dequeue
'...insert any folder processing code here...
For Each SubF In FF.SubFolders
queue.Add SubF 'enqueue
Next SubF
For Each file In FF.Files
If InStr(1, file.Name, "rels") = 0 Then
If InStr(1, file.Name, "core") <> 0 Then
Content_Typesxml = Content_Typesxml & "< Override PartName=""/" & FF.Name & "/" & file.Name & """ ContentType=""application/vnd.openxmlformats-package." & Replace(file.Name, ".", "-properties+") & """/>" & vbNewLine
Else
If InStr(1, FF.Name, "word") <> 0 Then
If InStr(1, file.Name, "document") <> 0 Then
Content_Typesxml = Content_Typesxml & "< Override PartName=""/" & FF.Name & "/" & file.Name & """ ContentType=""application/vnd.openxmlformats-officedocument.wordprocessingml." & Replace(file.Name, ".", ".main+") & """/>" & vbNewLine
Else
Content_Typesxml = Content_Typesxml & "< Override PartName=""/" & FF.Name & "/" & file.Name & """ ContentType=""application/vnd.openxmlformats-officedocument.wordprocessingml." & Replace(file.Name, ".", "+") & """/>" & vbNewLine
End If
Else
If InStr(1, file.Name, "app") <> 0 Then
Content_Typesxml = Content_Typesxml & "< Override PartName=""/" & FF.Name & "/" & file.Name & """ ContentType=""application/vnd.openxmlformats-officedocument.extended-properties+xml""/>" & vbNewLine
Else
Content_Typesxml = Content_Typesxml & "< Override PartName=""/" & FF.Name & "/" & file.Name & """ ContentType=""application/vnd.openxmlformats-officedocument." & Replace(file.Name, ".", "-properties+") & """/>" & vbNewLine
End If
End If
End If
End If
Next file
Loop
Content_Typesxml = Content_Typesxml & "< /Types>" & vbNewLine
Call ToFile(Content_Typesxml, Content_TypeFolder, "[Content_Types]", "xml")
'Because widows cannot zipped Empty Folder delete Empty Sub Folders
Set fso = CreateObject("scripting.filesystemobject")
Set FF = fso.GetFolder(FolderPath)
For Each SubF In FF.SubFolders
With SubF
If SubF.SubFolders.Count = 0 And .Files.Count = 0 Then fso.deletefolder SubF
End With
Next SubF
Set FF = Nothing
'Copy the files & folders into the zip file
Set ShellApp = CreateObject("Shell.Application")
On Error Resume Next
ShellApp.Namespace(ZipPath).CopyHere ShellApp.Namespace(FolderPath).items
On Error GoTo 0
'Zipping the files may take a while, create loop to pause the macro until zipping has finished.
On Error Resume Next
Do Until ShellApp.Namespace(ZipPath).items.Count = ShellApp.Namespace(FolderPath).items.Count
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0
If ShellApp.Namespace(ZipPath).items.Count = ShellApp.Namespace(FolderPath).items.Count Then Name ZipPath As DocxPath
On Error Resume Next
fso.deletefolder FolderPath
Set wrdApp = Nothing
Set wrdApp = CreateObject("word.Application")
wrdApp.Visible = True
wrdApp.Activate
Set wrdDoc = wrdApp.documents.Open(DocxPath)
On Error GoTo 0
Set wrdApp = Nothing
Set fso = Nothing
Set ShellApp = Nothing
'Call subRefreshDesktop
Application.ScreenUpdating = True
End Sub
Public Sub creatDoc(WS As Worksheet, TblRng As Range)
Dim wrdApp As Object
Dim wrdDoc As Object
Dim fso As Object
Dim FF As Object
Dim file As Object
Dim SubF As Object
Dim HTMDoc As String
Dim wdFormatXMLDocument '?????????????
Dim DefultPath As String, DocPath As String, DocFile As String, HtmPath As String, HtmFile As String, FolderPath As String, DocName As String
Dim colorschememapping As String, filelist As String
'''''''''''''''''''''''
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''' Here to Get HTML code to Create Doc or Docx File just change File Neme Extension ''''''''''''''''
HTMDoc = Split(GetTable(WS, TblRng), "|")(0)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
DefultPath = ThisWorkbook.Path & ""
DocFile = "Doc1.doc" ' or "Doc1.docx"
DocPath = DefultPath & DocFile
HtmFile = "Doc1.htm"
HtmPath = DefultPath & HtmFile
Set fso = CreateObject("scripting.filesystemobject")
'Close exist and deleted File
On Error Resume Next
Set wrdDoc = GetObject(DocPath)
If wrdDoc Is Nothing Then
Kill DocPath
Else
wrdDoc.Parent.Quit
wrdDoc.Close
Kill DocPath
End If
On Error GoTo 0
FolderPath = DefultPath & Split(DocFile, ".")(0) & ".files"
If Len(Dir(FolderPath, vbDirectory)) = 0 Then
MkDir FolderPath
Else
On Error Resume Next
fso.deletefolder FolderPath
MkDir FolderPath
On Error GoTo 0
On Error Resume Next
Do Until Len(Dir(FolderPath, vbDirectory)) > 0
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0
End If
'MkDir FolderPath & "" & "Root"
colorschememapping = "< ?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" & vbNewLine & _
"< a:clrMap xmlns:a=""http://schemas.openxmlformats.org/drawingml/2006/main"" bg1=""lt1"" tx1=""dk1"" bg2=""lt2"" tx2=""dk2"" accent1=""accent1"" accent2=""accent2"" accent3=""accent3"" accent4=""accent4"" accent5=""accent5"" accent6=""accent6"" hlink=""hlink"" folHlink=""folHlink""/>"
Call ToFile(colorschememapping, FolderPath, "colorschememapping", "xml")
Set fso = CreateObject("scripting.filesystemobject")
Set FF = fso.GetFolder(FolderPath)
filelist = "< xml xmlns:o=""urn:schemas-microsoft-com:office:office"">" & vbNewLine & _
" < o:MainFile HRef=""../" & DocFile & """/>" & vbNewLine
For Each file In FF.Files
With file
filelist = filelist & " < o:File HRef=""" & .Name & """/>" & vbNewLine
End With
Next
For Each SubF In FF.SubFolders
With SubF
filelist = filelist & " < o:File HRef=""" & .Name & """/>" & vbNewLine
For Each file In SubF.Files
filelist = filelist & " < o:File HRef=""" & .Name & """/>" & vbNewLine
Next
End With
Next
filelist = filelist & " < o:File HRef=""filelist.xml""/>" & vbNewLine & _
"< /xml>"
Call ToFile(filelist, FolderPath, "filelist", "xml")
DocName = Split(HtmFile, ".")(0)
Call ToFile(HTMDoc, DefultPath, DocName, "htm")
Set fso = CreateObject("scripting.filesystemobject")
On Error Resume Next
Set wrdApp = CreateObject("word.Application")
wrdApp.Visible = True
wrdApp.Activate
Set wrdDoc = wrdApp.documents.Open(HtmPath)
'convert Html to Word Doc.
wrdDoc.SaveAs DocPath, wdFormatXMLDocument
' Kill HtmPath
fso.deletefolder FolderPath
On Error GoTo 0
Set wrdApp = Nothing
Set wrdDoc = Nothing
'''''''''''''''''''''''''''''''''
SecondsElapsed = Round(Timer - StartTime, 2)
'MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
'''''''''''''''''''''''''''''''''
End Sub
Public Function ToFile(TXT As String, Path As String, FileName As String, Ext As String)
Dim fsT As Object
Set fsT = CreateObject("ADODB.Stream")
With fsT
.Type = 2 'Specify stream type - we want To save text/string data.
.Charset = "UTF-8" 'Specify charset For the source text data.
.Open 'Open the stream And write binary data To the object
.WriteText TXT
.SaveToFile Path & "" & FileName & "." & Ext, 2 'Save binary data To disk
End With
End Function
