package provide Tcl2ExXML 2.0
namespace eval Tcl2ExXML:: { ## ♦ DESCRIPTION: CREATE NAMESPACE VARIABLES ## • VARIABLE: WBCounter - <INT> COUNT OF ACTIVE WORKBOOKS ## • ARRAY/VARIABLE: WorkBooksArray :KEY = (WB<INT> ) :VALUE = <STRING> WORKBOOK NAME ## • ARRAY/VARIABLE: RowCounter :KEY = (WB<INT>.WS<INT> ) :VALUE = <INT> COUNT OF ACTIVE ROWS ON GIVEN WORKBOOK ## • ARRAY/VARIABLE: ColCounter :KEY = (WB<INT>.WS<INT> ) :VALUE = <INT> COUNT OF ACTIVE COLUMN ON GIVEN WORKBOOK ## • ARRAY/VARIABLE: StylesCounter :KEY = (WB<INT>.WS<INT> ) :VALUE = <INT> COUNT OF STYLES ON GIVEN WORKBOOK ## • ARRAY/VARIABLE: StylesArray :KEY = (WB<INT>.S<INT>.<SO_1><SO_2><So_n> ) :VALUE = ## • ARRAY/VARIABLE: ColStyle :KEY = (WB<INT>.WS<INT>.CIXD<INT>.<ATTRIBUTES>_n ) :VALUE = <INT> STYLES FOR GIVEN COLUMN ON GIVEN WORKSHEET ## • ARRAY/VARIABLE: RowStyle :KEY = (WB<INT>.WS<INT>.RIDX<INT> ) :VALUE = <INT> STYLES FOR GIVEN ROW ON GIVEN WORKSHEET ## • ARRAY/VARIABLE: WorkSheets :KEY = (WB<INT>.WS<INT> ) :VALUE = <INT> COUNT OF ACTIVE WORKSHEETS PER WORKBOOK ## • ARRAY/VARIABLE: WorkSheetsArray :KEY = (WB<INT>.WS<INT> ) :VALUE = <STRING> WORKSHEET NAME ## • VARIABLE: ColumnDefault - <INT> DEFAULT MAPPING OF COLUMN COUNT (A 1, B 2, C 3,.....) ## • LIST: ColumnIndex - COLUMN INDEX MAPPING (A 1, B 2, C 3,.....) ## • ARRAY/VARIABLE: Data :KEY = (WB<INT>.WS<INT>RN<INT>CN<INT> ) :VALUE = CELL DATA.
variable WBCounter
variable WorkBooksArray
variable RowCounter
variable ColCounter
variable StylesCounter
variable ColStyle
variable RowStyle
variable WorkSheets
variable WorkSheetsArray
variable StylesArray
variable ColumnDefault 500
variable ColumnIndex
variable Data} ## <== END OF namespace eval
## ♦ DESCRIPTION: CREATE A COLUMN MAPPING INDEX ## ◘ RETURN: LIST, INDEX FOR COLUMN NAMES TO CORRESPONDING LETTER proc Tcl2ExXML::_CreateColIdx {{ColIxdWdth 500}} {
variable ColumnIndex;
set alphabetList [list A B C D E F G H I J K L M N O P Q R S T U V W X Y Z];
set ColIxdWdth 500;
set idxCounter 1;
set CLI0 -1;
set LetterIdxInt 0;
set LetterIdxStng {[lindex $alphabetList $CLI0]${letter}}
set IncrementCmd "incr CLI0;"
for {set i 1} {$i < [expr {[expr {$ColIxdWdth/26}]+2}]} {incr i} {
if {![expr {$idxCounter%703}]} {
incr LetterIdxInt;
set LetterIdxStng "\[lindex \$alphabetList \$CLI0\]\[lindex \$alphabetList \$CLI$LetterIdxInt\]\${letter}"
set CLI0 0;
set CLI$LetterIdxInt 0;
set IncrementCmd "incr CLI$LetterIdxInt;"
}
foreach letter $alphabetList {
lappend ColumnIndex [list [subst ${LetterIdxStng}] $idxCounter]
incr idxCounter;
if {$ColIxdWdth < $idxCounter} {
return;
}
}
eval $IncrementCmd;
}
unset -nocomplain -- alphabetList idxCounter CLI0 LetterIdxInt IncrementCmd} ## <== END OF Tcl2ExXML::_CreateColIdx
## ♦ DESCRIPTION: CREATE A NEW WORKBOOK; ## • INPUT: WORKBOOK NAME; ## ◘ RETURN: POINTER TO THE WOORKBOOK WB<INT>; proc Tcl2ExXML::CreateWorkbook {WBName} {
incr Tcl2ExXML::WBCounter
set workbookId WB$Tcl2ExXML::WBCounter
set Tcl2ExXML::WorkBooksArray($workbookId) $WBName
return $workbookId} ## <== END OF Tcl2ExXML::CreateWorkbook ## ♦ DESCRIPTION: DELETE A WORKBOOK; ## • INPUT: WORKBOOK ID TO DELETE; ## ◘ RETURN: 0 ON SUCCESS 1 ON ERROR; proc Tcl2ExXML::DeleteWorkbook {workbookId} {
variable WorkBooksArray
variable WBCounter
variable WorkSheets
variable WorkSheetsArray
variable RowCounter
variable ColCounter
variable StylesCounter
variable StylesArray
variable ColStyle
variable RowStyle
variable Data
if {[array exists WorkBooksArray($workbookId)]} {
incr WBCounter -1
array unset WorkBooksArray ${workbookId}*
array unset WorkSheetsArray ${workbookId}*
array unset WorkSheets ${workbookId}*
array unset RowCounter ${workbookId}*
array unset ColCounter ${workbookId}*
array unset StylesCounter ${workbookId}*
array unset StylesArray ${workbookId}*
array unset ColStyle ${workbookId}*
array unset RowStyle ${workbookId}*
array unset Data ${workbookId}*
return 0
} else {
return 1
}} ## ♦ CREATED: FRIDAY, 04/28/17 11:44 AM; ## ♦ CREATOR: CHAD A KIMMELL; ## ♦ DESCRIPTION: INTERNAL PROCEDURE TO VERIFY WORKBOOK EXIST; ## • PARAMETERS: WORKBOOK ID; ## ◘ RETURN: ERROR IF WORKBOOK DOES NOT EXIST; NULL OTHERWISE; proc Tcl2ExXML::_WorkBookExist {workbookId} {
variable WorkBooksArray
return [info exists WorkBooksArray($workbookId)];} ## <== END OF Tcl2ExXML::_WorkBookExist
## ♦ CREATED: FRIDAY, 04/28/17 11:44 AM; ## ♦ CREATOR: CHAD A KIMMELL; ## ♦ DESCRIPTION: INTERNAL PROCEDURE TO VERIFY WORKSHEET EXIST; ## • INPUT: WORKBOOK ID; ## ◘ RETURN: BOOL proc Tcl2ExXML::_WorkSheetExist {workSheet} {
variable WorkSheetsArray
return [info exists WorkSheetsArray($workSheet)];} ## <== END OF Tcl2ExXML::_WorkSheetExist
## ♦ CREATED: FRIDAY, 04/28/17 11:44 AM; ## ♦ CREATOR: CHAD A KIMMELL; ## ♦ DESCRIPTION: INTERNAL PROCEDURE TO VERIFY STYLE EXIST; ## • INPUT: WORKBOOK ID; ## ◘ RETURN: BOOL proc Tcl2ExXML::_StyleExist {styleName} {
variable StylesCounter
lassign [split $styleName .] WorkSheet Style
if {[info exist StylesCounter($WorkSheet)]} {
set StyleInt [string map -nocase {s ""} $Style]
if {[string is integer -strict $StyleInt]} {
if {$StyleInt <= $StylesCounter($WorkSheet)} {
return 1;
} else {
error "The provided style does not exist: $StyleInt"
}
} else {
error "Invalid style provided while validating if style exist: Value $styleName"
}
} else {
error "No styles found in Worksheet: $WorkSheet"
}} ## <== END OF Tcl2ExXML::_StyleExist
## ♦ CREATED: FRIDAY, 04/28/17 11:44 AM; ## ♦ CREATOR: CHAD A KIMMELL; ## ♦ DESCRIPTION: INTERNAL PROCEDURE TO OBTAIN THE COLUMN NUMBER GIVEN A LETTER SEQ ## • INPUT: COLUMN LETTER SEQUENCE ## ◘ RETURN: INT, ABORTS ON ERROR. proc Tcl2ExXML::_ColIdx {ColLetSeq} {
variable ColumnIndex;
set idx [lsearch -nocase -index 0 $Tcl2ExXML::ColumnIndex $ColLetSeq];
if {$idx == -1} {
error "Letter Sequence $ColLetSeq is not defined. Expand the Sequencing with command Tcl2ExXML::CreateColIdx <MAX-idx>"
}
return [lindex $ColumnIndex $idx 1]} ## <== END OF Tcl2ExXML::_ColIdx
## ♦ CREATED: FRIDAY, 04/28/17 11:44 AM; ## ♦ CREATOR: CHAD A KIMMELL; ## ♦ DESCRIPTION: CREATE A WORKSHEET FOR A WOOKBOOK, WORKBOOK MUST EXIST, ABORT ON ERROR; ## • INPUT: WORKBOOKID, NAME OF WORKSEET; ## ◘ RETURN: WORKSHEET ID, ABORT ON ERROR; proc Tcl2ExXML::CreateWorkSheet {workbookId WSName} {
variable WorkSheets
variable WorkSheetsArray
variable RowCounter
variable ColCounter
#VERIFY THAT WE HAVE A VALID WORKBOOK
if {![_WorkBookExist $workbookId]} {
error "WorkBook $workbookId does not exist. Workbook must be valid.";
}
#INCREMENT THE COUNT IF WORKSHEETS EXIST IN THE WORKBOOK;
if {![info exists WorkSheets($workbookId)]} {
#IF THIS IS THE FIRST WS FOR THE WB INITIALIZE THE ELEMENT;
set WorkSheets($workbookId) 1
} else {
#NOW THAT WE KNOW THE WORKBOOK IS VALID, LET'S VERIFY THAT THE WORKBOOK NAME DOES NOT ALEADY EXIST-
#GET THE KEYS FOR THE WORKSHEET ARRAY;
#WORKSHEET NAME CAN NOT BE LONGER THAN 31 CHARS
if {[string length $WSName] >= 32} {
set WSName [string range 0 28]...
puts stderr "WorkSheet Name Length greater than 31 characters.\nWorkseet Name truncated to: $WSName"
}
foreach {Key Name} [array get WorkSheetsArray ${workbookId}*] {
if {$Name == $WSName} {
error "Workbook $workbookId already contans a WorkSheet with the name of $WSName."
}
}
incr WorkSheets($workbookId)
}
set WSID ${workbookId}.WS$Tcl2ExXML::WorkSheets($workbookId)
set WorkSheetsArray($WSID) $WSName
set RowCounter($WSID) 0
set ColCounter($WSID) 0
return $WSID} ## <== END OF Tcl2ExXML::CreateWorkSheet
## ♦ CREATED: FRIDAY, 04/28/17 11:44 AM; ## ♦ CREATOR: CHAD A KIMMELL; ## ♦ DESCRIPTION: CREATE A STYLE FOR A WORKBOOK, WORKBOOK MUST EXIST, ABORTS OTHERWISE; ## • INPUT: WORKBOOKID, STYLE OPTIONS ; ## ◘ RETURN: WORKSHEET ID, ABORT ON ERROR; proc Tcl2ExXML::CreateStyle {workbook args} {
variable StylesArray
variable StylesCounter
#VERIFY THAT THE WORKBOOK EXIST;
if {[Tcl2ExXML::_WorkBookExist $workbook]} {
#VERIFY THAT WE HAVE AT LEAST ONE NAMED PAIR OF VALUES TO SET;
if {[llength $args] < 2} {
error "Minimum of one style option is required."
}
#VERIFY IF ANY STYLES EXIST; INCR IF DOES, CREATE IF NOT;
if {[info exists Tcl2ExXML::StylesCounter($workbook)]} {
incr StylesCounter($workbook)
} else {
set StylesCounter($workbook) 2
}
set styleName ${workbook}.S$Tcl2ExXML::StylesCounter($workbook)
foreach {name value} $args {
#VERIFY THAT WE HAVE BEEN GIVEN PROPER SWITCHES;
if {[lsearch -nocase "-algnmt -rotate -vertxt -wrap -mergh -mergv -font -border -interior -datafmt" $name] == -1} {
error "Style option $name option is not supported"
}
switch -nocase -- $name {
-algnmt {
foreach {algnmtOpt algnmtvalue} $value {
#VERIFY THE PROPER CHILD VALUES WERE INCLUDED.
if {[lsearch "-v -h" $algnmtOpt] == -1} {
error "Style option $algnmtOpt is not supported for object class '-algnmt'"
}
#VALIDATE THAT WE HAVE BEEN GIVEN PROPER VALUES ONCE AGAIN, IF WE HAVE CREATE THE ITEM IN THE DATA ARRAY;
switch $algnmtOpt {
-v {
if {[lsearch -nocase "automatic top center bottom" $algnmtvalue] == -1} {
error "Invlaid option provided for object class '-algnmt' inherited class '-v'. Value: $algnmtvalue\n Should be one of: 'Top, Center, Bottom'"
}
set StylesArray(${styleName}.${name}.${algnmtOpt}) [string tolower $algnmtvalue];
}
-h {
if {[lsearch -nocase "automatic left center right" $algnmtvalue] == -1} {
error "Invlaid option provided for object class '-algnmt' inherited class '-h'. Value: $algnmtvalue\n Should be one of: 'Right, Center, Left'"
}
set StylesArray(${styleName}.${name}.${algnmtOpt}) [string tolower $algnmtvalue];
}
}
}
}
-rotate {
#VERT TEXT AND ROTATE ARE MUTUALLY EXCLUSIVE, CHECK THAT THE OTHER DOES NOT EXIST;
if {[info exist StylesArray(${styleName}.-vertxt)]} {
error "\"Vertical Text\" and \"Rotate Text\" are mutually exclusive and can not be used at the same time.";
}
#TEST IF THE VALUE GIVEN IS A PROPER INTAGER;
set testInt $value
if {[catch {incr testInt} err]} {
error "Invalid option for object class '-rotate': $err"
}
#NOW WE NEED TO VALIDATE THAT THE VALUE IS BETWEEN -90 AND 90
if {$value < -90 || $value > 90} {
error "Invalid integer provided for class '-rotate'. Value MUST be between -90 and 90."
}
set StylesArray(${styleName}.${name}) $value
}
-vertxt {
#VERT TEXT AND ROTATE ARE MUTUALLY EXCLUSIVE, CHECK THAT THE OTHER DOES NOT EXIST;
if {[info exist StylesArray(${styleName}.-rotate)]} {
error "\"Vertical Text\" and \"Rotate Text\" are mutually exclusive and can not be used at the same time.";
}
#VERIFY THAT WE HAVE BEEN GIVEN A BOOL VALUE;
if {[string is boolean -strict $value] == 0} {
error "Expected boolean value for object class '-vertxt'. Got $value instead."
}
if {[string tolower $value] in {1 true yes on}} {
set StylesArray(${styleName}.${name}) 1
} else {
set StylesArray(${styleName}.${name}) 0
}
}
-wrap {
#VERIFY THAT WE HAVE BEEN GIVEN A BOOL VALUE;
if {[string is boolean -strict $value] == 0} {
error "Expected boolean value for object class '-wrap'. Got $value instead."
}
if {[string tolower $value] in {1 true yes on}} {
set StylesArray(${styleName}.${name}) 1
} else {
set StylesArray(${styleName}.${name}) 0
}
}
-mergh {
#MERGE CELLS TO THE RIGHT -
#TEST IF THE VALUE GIVEN IS A PROPER INTAGER;
set testInt $value
if {[catch {incr testInt} err]} {
error "Invalid option for object class '-mergh': $err"
}
set StylesArray(${styleName}.${name}) $value
}
-mergv {
#MERGE CELLS DOWN FROM CURRENT -
#TEST IF THE VALUE GIVEN IS A PROPER INTAGER;
set testInt $value
if {[catch {incr testInt} err]} {
error "Invalid option for object class '-mergv': $err"
}
set StylesArray(${styleName}.${name}) $value
}
-font {
foreach {fontOpt fontValue} $value {
#VERIFY THEH PROPER CHILD VALUES WERE INCLUDED.
if {[lsearch {-nm -ff -sz -fc -b -i -u} $fontOpt] == -1 } {
error "Style option '$fontOpt' is not supported for object class '-font'"
}
switch $fontOpt {
-nm {
#TODO: FIND A WAY TO VALIDATE PROPER FONT NAMES
set StylesArray(${styleName}.${name}.${fontOpt}) [string tolower $fontValue];
}
-ff {
#TODO: FIND A WAY TO VALIDATE THE FAMILY ASSOCIATED TO THE FONT.
set StylesArray(${styleName}.${name}.${fontOpt}) [string tolower $fontValue];
}
-sz {
set testInt $fontValue
if {[catch {incr testInt} err]} {
error "Invalid option for object class '-font' inherited class '-sz': $err"
}
set StylesArray(${styleName}.${name}.${fontOpt}) $fontValue
}
-fc {
if {[string is xdigit -strict [string map {"#" ""} $fontValue]] == 0} {
error "Expected hexadecimal value for object class '-font' inherited class '-fc'. Got $fontValue instead."
}
set StylesArray(${styleName}.${name}.${fontOpt}) $fontValue
}
-b {
if {[string is boolean -strict $fontValue] == 0} {
error "Expected boolean value for object class '-font' inherited class '-b'. Got $fontValue instead."
}
if {[lsearch -nocase "0 false no off" $fontValue] == 0} {
set StylesArray(${styleName}.${name}.$fontOpt) 0
} else {
set StylesArray(${styleName}.${name}.${fontOpt}) 1
}
}
-u {
if {[string is boolean -strict $fontValue] == 0} {
error "Expected boolean value for object class '-font' inherited class '-u'. Got $fontValue instead."
}
if {[lsearch -nocase "0 false no off" $fontValue] == -1} {
set StylesArray(${styleName}.${name}.${fontOpt}) 0
} else {
set StylesArray(${styleName}.${name}.$fontOpt) 1
}
}
-i {
if {[string is boolean -strict $fontValue] == 0} {
error "Expected boolean value for object class '-font' inherited class '-i'. Got $fontValue instead."
}
if {[lsearch -nocase "0 false no off" $fontValue] == -1} {
set StylesArray(${styleName}.${name}.${fontOpt}) 0
} else {
set StylesArray(${styleName}.${name}.${fontOpt}) 1
}
}
}
}
}
-border {
set ParamFound 0;
for {set count 0} {$count <[llength $value]} {incr count;} {
set opt [lindex $value $count];
if {[regexp {^-[A-Za-z]{1,2}} $opt]} {
if {$opt == "-bp"} {
set BdrPos [lindex $value [expr {$count+1}]];
set BdrSid [llength $BdrPos];
#VERIFY IF WE WERE GIVEN A LIST, IF WE HAVE VALIDATE EACH OF THE ITEMS;
if {$BdrSid > 1} {
if {$BdrSid > 4} {
error "'$BdrPos' count exceeds the maxumum sides."
}
#VERIFY THAT WE HAVE BEEN GIVEN THE PROPER VALUES.
foreach side $BdrPos {
if {[lsearch -nocase "right left top bottom" $side] == -1} {
error "Invalid value provided for object class '-border' subclass '-bp'. Got $side instead."
}
}
} else {
if {[lsearch -nocase "right left top bottom" $BdrPos] == -1} {
error "Invalid value provided for object class '-border' subclass '-bp'. Got $BdrPos instead."
}
}
#CHECK TO SEE IF WE ARE GIVEN ADDITIONAL STYLE PARAMS, IF WE ARE NOT WE WILL USE THE DEFAULT;
set adjParam [lindex $value [expr {$count+2}]];
switch $adjParam {
-ls {
#WE HAVE FOUND AN ADDITIONAL PARAM, GET IT'S VALUE, VERIFY IT IS CORRECT AND SET THE OBJECT;
set LineStyle [string tolower [lindex $value [expr {$count+3}]]];
if {[lsearch "continuous dot dashdot dashdotdot dash double slantdashdot" $LineStyle] == -1} {
error "Invalid linetype given for '-border' subcommand '-ls'; Value $LineStyle"
}
set ParamFound 1;
}
-lw {
set LineWeight [lindex $value [expr {$count+3}]];
set IntTest $LineWeight;
if {[catch {incr $IntTest} err]} {
error "Expected an integer for object class '-border' inherited class '-wt'. Got $LineWeight instead."
}
set ParamFound 3;
}
-lc {
set LineColor [lindex $value [expr {$count+3}]];
if {[string is xdigit -strict [string map {"#" ""} $LineColor]] == 0} {
error "Expected hexadecimal value for object class '-border' inherited class '-lc'. Got $LineColor instead."
}
set ParamFound 6;
}
}
#IF WE FOUND ONE PARAMETER, LET'S SEE IF WE CAN FIND THE OTHER? AGAIN IF WE DON'T FIND IT WE WILL USE A DEFAULT;
set nextAdjParam [lindex $value [expr {$count+4}]];
switch $nextAdjParam {
-ls {
#WE HAVE FOUND AN ADDITIONAL PARAM, GET IT'S VALUE, VERIFY IT IS CORRECT AND SET THE OBJECT;
set LineStyle [string tolower [lindex $value [expr {$count+5}]]];
if {[lsearch "continuous dot dashdot dashdotdot dash double slantdashdot" $LineStyle] == -1} {
error "Invalid linetype given for '-border' subcommand '-ls'; Value $LineStyle"
}
set ParamFound [expr {$ParamFound+1}];
}
-lw {
set LineWeight [lindex $value [expr {$count+5}]];
set IntTest $LineWeight;
if {[catch {incr $IntTest} err]} {
error "Expected an integer for object class '-border' inherited class '-wt'. Got $LineWeight instead.";
}
set ParamFound [expr {$ParamFound+3}];
}
-lc {
set LineColor [lindex $value [expr {$count+5}]];
if {[string is xdigit -strict [string map {"#" ""} $LineColor]] == 0} {
error "Expected hexadecimal value for object class '-border' inherited class '-lc'. Got $LineColor instead."
}
set ParamFound [expr {$ParamFound+6}];
}
}
#IF WE FOUND A SECOND PARAMETER, LET'S SEE IF WE CAN FIND THE OTHER? AGAIN IF WE DON'T FIND IT WE WILL USE A DEFAULT;
set nextnextAdjParam [lindex $value [expr {$count+6}]];
switch $nextnextAdjParam {
-ls {
#WE HAVE FOUND AN ADDITIONAL PARAM, GET IT'S VALUE, VERIFY IT IS CORRECT AND SET THE OBJECT;
set LineStyle [string tolower [lindex $value [expr {$count+7}]]];
if {[lsearch "continuous dot dashdot dashdotdot dash double slantdashdot" $LineStyle] == -1} {
error "Invalid linetype given for '-border' subcommand '-ls'; Value $LineStyle"
}
set ParamFound [expr {$ParamFound+1}];
}
-lw {
set LineWeight [lindex $value [expr {$count+7}]];
set IntTest $LineWeight;
if {[catch {incr $IntTest} err]} {
error "Expected an integer for object class '-border' inherited class '-wt'. Got $LineWeight instead.";
}
set ParamFound [expr {$ParamFound+3}];
}
-lc {
set LineColor [lindex $value [expr {$count+7}]];
if {[string is xdigit -strict [string map {"#" ""} $LineColor]] == 0} {
error "Expected hexadecimal value for object class '-border' inherited class '-lc'. Got $LineColor instead."
}
set ParamFound [expr {$ParamFound+6}];
}
}
#NOW WE **SHOULD** HAVE ALL OF THE INFORMATION THAT WE NEED TO GENERATE THE OBJECT NOW;
for {set t 0} {$t < $BdrSid} {incr t} {
switch $ParamFound {
0 {
set StylesArray(${styleName}.${name}.[lindex $BdrPos $t]) "continuous 1";
}
1 {
set StylesArray(${styleName}.${name}.[lindex $BdrPos $t]) "[string tolower $LineStyle] 1";
}
3 {
set StylesArray(${styleName}.${name}.[lindex $BdrPos $t]) "continuous $LineWeight";
}
4 {
set StylesArray(${styleName}.${name}.[lindex $BdrPos $t]) "[string tolower $LineStyle] [string tolower $LineWeight]";
}
6 {
set StylesArray(${styleName}.${name}.[lindex $BdrPos $t]) "continuous 1 $LineColor";
}
7 {
set StylesArray(${styleName}.${name}.[lindex $BdrPos $t]) "[string tolower $LineStyle] 1 $LineColor";
}
9 {
set StylesArray(${styleName}.${name}.[lindex $BdrPos $t]) "continuous $LineWeight $LineColor";
}
10 {
set StylesArray(${styleName}.${name}.[lindex $BdrPos $t]) "[string tolower $LineStyle] $LineWeight $LineColor";
}
}
}
}
}
}
}
-interior {
foreach {interiorOpt interiorValue} $value {
if {[lsearch "-ic -ip -ipc" $interiorOpt] ==-1} {
error "Style option $interiorOpt option is not supported for class '-interior'";
}
switch $interiorValue {
-ic {
if {[string is xdigit -strict [string map {"#" ""} $interiorValue]] == 0} {
error "Expected hexadecimal value for object class '-interior' inherited class '-ic'. Got $interiorValue instead.";
}
set StylesArray(${styleName}.${name}.${interiorOpt}) $interiorValue
}
-ip {
if {[lsearch -nocase "thindiagcross thinhorzcross thindiagstripe thinreversediagstripe thinvertstripe thinhorzstripe thickdiagcross diagcross diagstripe reversediagstripe vertstripe horzstripe gray0625 gray125 gray75 gray50 gray25" $interiorValue ==-1]} {
error "Invalid interior Pattern given for class '-interior' subclass '-ip'; Value $interiorValue";
}
set StylesArray(${styleName}.${name}.${interiorOpt} $interiorValue;
}
-ipc {
set StylesArray(${styleName}.${name}.${interiorOpt}) $interiorValue;
}
}
}
}
-datafmt {
if {[lsearch -nocase "sdate mdate ldate ymd t24 t12 curr nbr pct 0" $value] == -1} {
error "Unsuported data format given for -datafmt argument; Value $value";
}
switch $value {
sdate {
set StylesArray(${styleName}.${name}) {m/d/yy;@}
}
mdate {
set StylesArray(${styleName}.${name}) {[ENG][$-409]d\-mmm\-yy;@}
}
ldate {
set StylesArray(${styleName}.${name}) {[ENG][$-409]mmmm\ d\,\ yyyy;@}
}
ymd {
set StylesArray(${styleName}.${name}) {yyyy\-mm\-dd}
}
t24 {
set StylesArray(${styleName}.${name}) {h:mm;@}
}
t12 {
set StylesArray(${styleName}.${name}) {[$-409]h:mm\ AM/PM;@}
}
curr {
set StylesArray(${styleName}.${name}) {"$"#,##0.00}
}
nbr {
set StylesArray(${styleName}.${name}) {Number}
}
pct {
set StylesArray(${styleName}.${name}) {Percent}
}
str {
set StylesArray(${styleName}.${name}) {String}
}
0 {
set StylesArray(${styleName}.${name}) {0}
}
}
}
}
}
return $styleName
} else {
error "Workbook: $workbook not valid. Please indicate a valid workbook.";
}} ## <== END OF Tcl2ExXML::createStyle
## ♦ CREATED: FRIDAY, 04/28/17 11:44 AM; ## ♦ CREATOR: CHAD A KIMMELL; ## ♦ DESCRIPTION: CREATE COLUMN ATTABUTES, WORKBOOK MUST EXIST, ABORTS OTHERWISE; ## • INPUT: WORKSHEETID, STYLE OPTIONS ; ## ◘ RETURN: NULL STRING, ABORT ON ERROR; proc Tcl2ExXML::setColumnAttributes {workSheet columnIndex args} {
variable ColStyle;
#VALIDATE THAT THE WORKBOOK/WORKSHEET EXIST;
if {[_WorkSheetExist $workSheet]} {
#WORKSHEET IS VALID, LET'S CHECK IF THE COLUMN IS VALID AS WELL -
#CHECK IF WE WERE GIVEN A COLUMN NUMBER OR A NAME;
if {[regexp {\d{1,3}} $columnIndex]} {
set ColIdxNbr $columnIndex;
} elseif {[regexp -nocase {[a-z]{1,3}} $columnIndex]} {
set ColIdxNbr [_ColIdx $columnIndex];
} else {
error "Unable to determine Column index for given value: $columnIndex";
}
#VERIFY THAT WE HAVE AT LEAST ONE NAMED PAIR OF VALUES TO SET;
if {[llength $args] < 2} {
error "Minimum of one column attribute option is required."
}
foreach {name value} $args {
switch -nocase -- $name {
-w {
#SET COLUMN WIDTH -
#VERIFY THAT WE HAVE BEEN GIVEN AN INTEGER;
set testInt $value
if {[catch {incr testInt} err]} {
error "Invalid option for Column Attributes object class '-w': $err";
}
set ColStyle(${workSheet}.${ColIdxNbr}.${name}) $value
}
-afw {
#AUTO FIT WIDTH, ONLY BOOL TRUE WILL BE EVALUATED;
if {[string is boolean -strict $value] == 0} {
error "Expected boolean value for object class '-afw'. Got $value instead."
}
if {[lsearch -nocase "1 true yes on" $value] != -1} {
set ColStyle(${workSheet}.${ColIdxNbr}.${name}) 1
}
}
-h {
#INDICATE IF THE COLUMN SHOULD BE HIDDEN;
if {[string is boolean -strict $value] == 0} {
error "Expected boolean value for object class '-h'. Got $value instead."
}
if {[lsearch -nocase "1 true yes on" $value] != -1} {
set ColStyle(${workSheet}.${ColIdxNbr}.${name}) 1
}
}
-s {
#VERIFY FIRST THAT THE STYLE ARRAY EXIST FOR THE GIVEN WORKSHEET;
if {[_StyleExist $value]} {
set ColStyle(${workSheet}.${ColIdxNbr}.${name}) $value
}
}
}
}
} else {
error "Worksheet: $workSheet not valid!";
}}; ## <====END OF Tcl2ExXML::setColumnAttributes
## ♦ CREATED: FRIDAY, 04/28/17 11:44 AM; ## ♦ CREATOR: CHAD A KIMMELL; ## ♦ DESCRIPTION: ADD ROW TO WORKSHEET, WORKSHEET MUST EXIST, ABORTS OTHERWISE; ## • INPUT: WORKSHEETID - ## • INPUT: ?ROW NUMBER (IF ROWS HAVE BEEN SKIPPED)? - ## • INPUT: LIST OF DATA, EACH LIST ITEM REPRESENTS THE NEXT ADJACENT COLUMN, IF DATA STARTS WITH '-c' - ## FOLLOWING LIST ITEM REPRESENTS THE COLUMN TO START THE DATA TO BE INSERTED INTO VALUE CAN BE AN INT OR COLUMN NAME; ## ◘ RETURN: INT , ABORT ON ERROR; proc Tcl2ExXML::addRow {workSheet args} {
variable RowCounter
variable ColCounter
variable ColStyle
variable Data
#SET INTERNAL VARIABLE;
set CN 1;
#ENSURE THAT THE WORKBOOK EXIST, ABORT IF IT DOES NOT;
if {[Tcl2ExXML::_WorkSheetExist $workSheet]} {
#CHECK IF A ROW HAS BEEN SPECIFIED;
if {[lindex $args 0] == "-r"} {
#A ROW HAS BEEN SPECIFIED, VALIDATE THAT IT IS A PROPER INTEGER;
set RN [lindex $args 1];
set testInt [lindex $args 1];
if {[catch {incr testInt} err]} {
error "Invalid Row Number provided: $err";
}
#DO SOME CHECKING TO ENSURE NO DATA COLLISIONS OCCUR -
#IS THIS ROW GREATER THAN PREVIOUS ROWS? IF IT IS WE CAN SKIP DATA VALIDATIONS;
if {$RN < $RowCounter($workSheet)} {
#THIS ROW IS NOT A "NEW" ROW, WE NEED TO VALIDATE NO DATA COLLISIONS OCCUR;
for {set i 2} {$i < [llength $args]} {incr i} {
#IF A PARTICUALR COL IS SPECIFIED;
if {[lindex $args $i] == "-c"} {
#CHECK THAT THE COLUMN IS VALID, MUST BE EITHER AN INTEGER OR COLUMN NAME;
if {[regexp {^\d{1,3}} [lindex $args [expr {$i+1}]] CN ]} {
#COL GIVEN IN INT FORM;
incr i 2;
} elseif {[regexp -nocase {^[a-z]{1,3}} [lindex $args [expr {$i+1}]]]} {
#COL NAME GIVEN, GET INTIGER VALUE FOR THE COL;
set CN [_ColIdx [lindex $args [expr {$i+1}]]]
incr i 2;
} else {
#UNABLE TO DETERMINE COLUMN, THOW AN ERROR;
error "Invalid column specified, must be an integer (1-999) or column name.";
}
}
#CHECK IF A STYLE IS SPECIFIED;
if {[lindex $args $i] == "-s"} {
#VALIDATE THAT THE STYLE EXIST;
if {[_StyleExist [lindex $args [expr {$i+1}]]]} {
set Data($workSheet.$RN.$CN.-s) [lindex $args [expr {$i+1}]];
incr i 2;
}
}
#VERIFY THAT DATA DOES NOT ALREADY EXIST FOR THE GIVEN INDEX;
if {[info exist Data($workSheet.$RN.$CN)]} {
error "Data collision ROW: $RN & COL: $CN]";
}
#DATA DOES NOT EXIST, WRITE THE INFORMATION TO THE ARRAY;
set Data($workSheet.$RN.$CN) [lindex $args $i];
#CHECK IF THIS ROW HAS EXPANDED THE ACTIVE COLUMN BOUNDRY;
if {$CN > $ColCounter($workSheet)} {
#IT DOES, WRITE THE NEW VALUE TO THE ARRAY;
set ColCounter($workSheet) $CN
}
incr CN;
}
} else {
#THIS IS A NEW ROW, WE DO NOT NEED TO VALIDATE
set RowCounter($workSheet) $RN;
for {set i 0} {$i < [llength $args]} {incr i} {
#CHECK IF A PARTICUALR COL IS SPECIFIED;
if {[lindex $args $i] == "-c"} {
#CHECK THAT THE COLUMN IS VALID, MUST BE EITHER AN INTEGER OR COLUMN NAME;
if {[regexp {^\d{1,3}} [lindex $args [expr {$i+1}]] CN ]} {
#COL GIVEN IN INT FORM;
incr i 2;
} elseif {[regexp -nocase {^[a-z]{1,3}} [lindex $args [expr {$i+1}]]]} {
#COL NAME GIVEN, GET INTIGER VALUE FOR THE COL;
set CN [Tcl2ExXML::_ColIdx [lindex $args [expr {$i+1}]]]
incr i 2;
} else {
#UNABLE TO DETERMINE COLUMN, THOW AN ERROR;
error "";
}
}
#CHECK IF A STYLE IS SPECIFIED;
if {[lindex $args $i] == "-s"} {
#VALIDATE THAT THE STYLE EXIST;
if {[_StyleExist [lindex $args [expr {$i+1}]]]} {
set Data($workSheet.$RN.$CN.-s) [lindex $args [expr {$i+1}]];
incr i 2;
}
}
#WRITE THE DATA TO THE ARRAY;
set Data($workSheet.$RN.$CN) [lindex $args $i];
#CHECK IF THIS ROW HAS EXPANDED THE ACTIVE COLUMN BOUNDRY;
if {$CN > $ColCounter($workSheet)} {
#IT DOES, WRITE THE NEW VALUE;
set ColCounter($workSheet) $CN
}
incr CN;
}
}
} else {
#NO ROW SPECIFIED, SET THE VALUE TO THE NEXT ROW IN THE SHEET;
incr RowCounter($workSheet);
set RN $RowCounter($workSheet);
for {set i 0} {$i < [llength $args]} {incr i} {
#IF A PARTICUALR COL IS SPECIFIED;
if {[lindex $args $i] == "-c"} {
#CHECK THAT THE COLUMN IS VALID, MUST BE EITHER AN INTEGER OR COLUMN NAME;
if {[regexp {^(\d{1,3})} [lindex $args [expr {$i+1}]]]} {
#COL GIVEN IN INT FORM;
set CN [lindex $args [expr {$i+1}]];
incr i 2;
} elseif {[regexp -nocase {^([a-z]{1,3})} [lindex $args [expr {$i+1}]]]} {
#COL NAME GIVEN, GET INTIGER VALUE FOR THE COL;
set CN [_ColIdx [lindex $args [expr {$i+1}]]]
incr i 2;
} else {
#UNABLE TO DETERMINE COLUMN, THOW AN ERROR;
error "Unable to determine the column provided.";
}
}
#CHECK IF A STYLE IS SPECIFIED;
if {[lindex $args $i] == "-s"} {
#VALIDATE THAT THE STYLE EXIST;
if {[_StyleExist [lindex $args [expr {$i+1}]]]} {
set Tcl2ExXML::Data($workSheet.$RN.$CN.-s) [lindex $args [expr {$i+1}]];
incr i 2;
}
}
#WRITE THE DATA TO THE ARRAY;
set Data($workSheet.$RN.$CN) [lindex $args $i];
#CHECK IF THIS ROW HAS EXPANDED THE ACTIVE COLUMN BOUNDRY;
if {$CN > $ColCounter($workSheet)} {
#IT DOES, WRITE THE NEW VALUE;
set Tcl2ExXML::ColCounter($workSheet) $CN
}
incr CN;
}
}
return $RowCounter($workSheet);
} else {
error "WorkSheet $workSheet does not exist."
}} ## <====END OF Tcl2ExXML::addRow
## ♦ CREATED: FRIDAY, 04/28/17 11:44 AM; ## ♦ CREATOR: CHAD A KIMMELL; ## ♦ DESCRIPTION: RETURN ALL DATA IN EXCEL XML 2003 WORKBOOK FORMAT ## • INPUT: WORKBOKID ## ◘ RETURN: XML STRING, ABORTS ON ERROR. proc Tcl2ExXML::outputXML {workbook} {
variable Data
variable ColStyle
variable ColCounter
variable WorkSheets
variable ColCounter
variable RowCounter
variable StylesArray
variable StylesCounter
variable WorkSheetsArray
#GET TCL ENVIRNMENTAL VARIABLES
upvar #0 env(USERNAME) User
upvar #0 env(USERDOMAIN) Company
if {[_WorkBookExist $workbook]} {
#START THE XML STRING;
set xml "<?xml version=\"1.0\"?>\n"
append xml " <?mso-application progid=\"Excel.Sheet\"?>\n"
append xml " <Workbook xmlns=\"urn:schemas-microsoft-com:office:spreadsheet\"\n"
append xml " xmlns:o=\"urn:schemas-microsoft-com:office:office\"\n"
append xml " xmlns:x=\"urn:schemas-microsoft-com:office:excel\"\n"
append xml " xmlns:ss=\"urn:schemas-microsoft-com:office:spreadsheet\"\n"
append xml " xmlns:html=\"http://www.w3.org/TR/REC-html40\">\n"
append xml " <DocumentProperties xmlns=\"urn:schemas-microsoft-com:office:office\">\n"
append xml " <Author>$User</Author>\n"
append xml " <Created>[clock format [clock seconds] -format {%Y-%m-%dT%H:%M:%S}]</Created>\n"
append xml " <Company>$Company</Company>\n"
append xml " <Version>15.00</Version>\n"
append xml " </DocumentProperties>\n"
append xml " <OfficeDocumentSettings xmlns=\"urn:schemas-microsoft-com:office:office\">\n"
append xml " <AllowPNG/>\n"
append xml " </OfficeDocumentSettings>\n"
append xml " <ExcelWorkbook xmlns=\"urn:schemas-microsoft-com:office:excel\">\n"
append xml " <WindowHeight>100</WindowHeight>\n"
append xml " <WindowWidth>100</WindowWidth>\n"
append xml " <WindowTopX>30</WindowTopX>\n"
append xml " <WindowTopY>30</WindowTopY>\n"
append xml " <ActiveSheet>1</ActiveSheet>\n"
append xml " <ProtectStructure>False</ProtectStructure>\n"
append xml " <ProtectWindows>False</ProtectWindows>\n"
append xml " </ExcelWorkbook>\n"
append xml " <Styles>\n"
append xml " <Style ss:ID=\"Default\" ss:Name=\"Normal\">\n"
append xml " <Alignment ss:Horizontal=\"Center\" ss:Vertical=\"Bottom\"/>\n"
append xml " <Borders/>\n"
append xml " <Font ss:FontName=\"Calibri\" x:Family=\"Swiss\" ss:Size=\"11\" ss:Color=\"#000000\"/>\n"
append xml " <Interior/>\n"
append xml " <NumberFormat/>\n"
append xml " <Protection/>\n"
append xml " </Style>\n"
#DETERMINE IF THERE ARE ANY STYLES THAT EXSIT FOR THE WORKBOOK;
if {[info exists StylesCounter($workbook)]} {
#STYLE(S) HAVE BEEN FOUND, NOW WE NEED TO GENERATE THE APPRORIATE XML TAGS;
for {set WbSc 2} {$WbSc <= $StylesCounter($workbook)} {incr WbSc} {
set WbSn $workbook.S$WbSc
set StyleName S$WbSc
#CHECK THAT THE STYLES ARRAY EXIST FIRST;
if {[array exists StylesArray]} {
#BEGIN GENERATING THE DYNAMIC STYLE CONTENT;
append xml " <Style ss:ID=\"$StyleName\">\n"
#IF ANY OF THE ALIGNMENT ELEMENTS ARE INDICATED GENERATE THE TAG -
#UNABLE TO GET KEY LIST DUE TO THE VARIETY OF OPTIONS, CHECK FOR EACH INDIVIDUALLY;
if {[info exist StylesArray($WbSn.-algnmt.-v)] || \
[info exist StylesArray($WbSn.-algnmt.-h)] || \
[info exist StylesArray($WbSn.-rotate)] || \
[info exist StylesArray($WbSn.-vertxt)] || \
[info exist StylesArray($WbSn.-wrap)] } {
append xml " <Alignment "
#APPEND EACH OF THE VALUES THAT EXIST IN THE ARRAY;
if {[info exist StylesArray($WbSn.-algnmt.-v)]} {
append xml "ss:Vertical=\"[string totitle $StylesArray($WbSn.-algnmt.-v)]\""
}
if {[info exist StylesArray($WbSn.-algnmt.-h)]} {
append xml " ss:Horizontal=\"[string totitle $StylesArray($WbSn.-algnmt.-h)]\""
}
#IF THE ROTATE ELEMENT IS INDICATED GENERATE THE TAG;
if {[info exist StylesArray($WbSn.-rotate)]} {
append xml " ss:Rotate=\"[string totitle $StylesArray($WbSn.-rotate)]\""
}
#IF THE VERTICALTEXT ELEMENT IS INDICATED GENERATE THE TAG;
if {[info exist StylesArray($WbSn.-vertxt)]} {
append xml " ss:VerticalText=\"[string totitle $StylesArray($WbSn.-vertxt)]\""
}
#IF THE WRAP TEXT ELEMENT IS INDICATED GENERATE THE TAG;
if {[info exist StylesArray($WbSn.-wrap)]} {
append xml " ss:WrapText=\"[string totitle $StylesArray($WbSn.-wrap)]\""
}
append xml "/>\n"
}
#GET A LIST OF THE FONT KEYS, GENERATE THE APPROPRIATE ELEMNETS, IF ANY EXIST;
set FontAttibuteList [array names StylesArray "$WbSn.-font.*"];
if {[llength $FontAttibuteList]} {
append xml " <Font"
foreach Param $FontAttibuteList {
switch $Param [list \
"${WbSn}.-font.-nm" { append xml " ss:FontName=\"[string totitle $StylesArray($WbSn.-font.-nm)]\""} \
"${WbSn}.-font.-ff" { append xml " x:Family=\"[string totitle $StylesArray($WbSn.-font.-ff)]\"" } \
"${WbSn}.-font.-sz" { append xml " ss:Size=\"$StylesArray($WbSn.-font.-sz)\"" } \
"${WbSn}.-font.-fc" { append xml " ss:Color=\"[string toupper $StylesArray($WbSn.-font.-fc)]\"" } \
"${WbSn}.-font.-b" { if {$StylesArray($WbSn.-font.-b)} { append xml " ss:Bold=\"1\"" }} \
"${WbSn}.-font.-u" { if {$StylesArray($WbSn.-font.-u)} { append xml " ss:Underline=\"1\"" }} \
"${WbSn}.-font.-i" { if {$StylesArray($WbSn.-font.-i)} { append xml " ss:Italic=\"1\"" }} \
]
}
append xml "/>\n"
}
#GET ANY OF THE BORDER ATTRIBUTES, IF THERE ARE ANY AND GENERATE THE TAGS;
set BorderAttibuteList [array names StylesArray "$WbSn.-border.*"];
if {[llength $BorderAttibuteList]} {
append xml " <Borders>\n"
foreach Param $BorderAttibuteList {
set BdrPos [lindex [split $Param .] 3]
set BdrPrams $StylesArray($Param)
if {[llength $BdrPrams] == 2} {
append xml " <Border ss:Position=\"[string totitle $BdrPos]\" ss:LineStyle=\"[string totitle [lindex $BdrPrams 0]]\" ss:Weight=\"[lindex $BdrPrams 1]\"/>\n"
} else {
append xml " <Border ss:Position=\"[string totitle $BdrPos]\" ss:LineStyle=\"[string totitle [lindex $BdrPrams 0]]\" ss:Weight=\"[lindex $BdrPrams 1]\" ss:Color=\"[lindex $BdrPrams 2]\"/>\n"
}
}
append xml " </Borders>\n"
}
set InteriorAttibuteList [array names StylesArray "$WbSn.-interior.*"];
if {[llength $InteriorAttibuteList]} {
append xml " <Interior"
foreach Param $BorderAttibuteList {
switch $Param [list \
"${WbSn}.-interior.-ic" { append xml " ss:Color=\"$StylesArray($Param)\""} \
"${WbSn}.-interior.-ip" { append xml " ss:Pattern=\"$StylesArray($Param)\""} \
"${WbSn}.-interior.-ipc" { append xml " ss:PatternColor=\"$StylesArray($Param)\""} \
]
}
append xml "/>\n"
}
#GET THE NUMBER FORMAT IF THERE IS ONE DEFINED;
if {[info exist StylesArray(${WbSn}.-datafmt)]} {
append xml " <NumberFormat ss:Format=\"$StylesArray(${WbSn}.-datafmt)\"/>\n"
}
}
append xml " </Style>\n"
}
}
append xml " </Styles>\n"
#BEGIN TO ADD THE DATA FOR EACH WORKSHEET IN THE WORKBOOK;
for {set WS 1} {$WS <= $WorkSheets($workbook)} {incr WS} {
append xml " <Worksheet ss:Name=\"$WorkSheetsArray(${workbook}.WS${WS})\">\n";
#SET THE WORKSHEET PARAMETERS;
append xml " <Table ss:ExpandedColumnCount=\"$ColCounter(${workbook}.WS${WS})\" ss:ExpandedRowCount=\"$RowCounter(${workbook}.WS${WS})\" x:FullColumns=\"1\" x:FullRows=\"1\" ss:DefaultColumnWidth=\"25\" ss:DefaultRowHeight=\"15\">\n";
#VERIFY IF THERE ARE ANY COLUMN ATTRIBUTES IN THE ARRAY THAT WE NEED TO SET;
set ColumnStyleKeys [array names ColStyle ${workbook}.WS${WS}*];
if {[llength $ColumnStyleKeys]} {
set ColString ""
#COLUMN STYLES EXIST, PROCESS THEM;
foreach Key $ColumnStyleKeys {
set cidx [lindex [split $Key .] 2];
switch $Key [list \
"${workbook}.WS${WS}.$cidx.-w" { append ColString " ss:Width=\"$ColStyle($Key)\"" } \
"${workbook}.WS${WS}.$cidx.-afw" { append ColString " ss:AutoFitWidth=\"$ColStyle($Key)\""} \
"${workbook}.WS${WS}.$cidx.-h" { append ColString " ss:Hidden=\"$ColStyle($Key)\"" } \
]
}
if {$ColString != ""} {
append xml " <Column $ColString />\n"
}
}
set SkippedRowFlag 0;
set SkippedColFlag 0;
for {set R 1} {$R <= $RowCounter($workbook.WS${WS})} {incr R} {
#CHECK IF DATA EXIST IN THIS ROW;
set RowCount [array names Data ${workbook}.WS${WS}.$R.*];
if {[llength $RowCount] > 0} {
#IF ROWS HAVE BEEN SKIPPED INDICATE THE ROW INDEX;
if {$SkippedRowFlag} {
append xml " <Row ss:Index=\"$R\" ss:AutoFitHeight=\"0\" ss:Height=\"15\">\n"
#RESET THE FLAG;
set SkippedRowFlag 0;
} else {
append xml " <Row ss:AutoFitHeight=\"0\" ss:Height=\"15\">\n"
}
#COLUMN LOOP;
set DataTypeFlag 0;
for {set C 1} {$C <= $ColCounter($workbook.WS${WS})} {incr C} {
#CHECK IF DATA EXIST FOR THE ROW & COL IDX;
if {[info exist Data(${workbook}.WS${WS}.$R.$C)]} {
set DataValue $Data(${workbook}.WS${WS}.$R.$C)
#CHECK THAT THERE IS ACTUALLY DATA AND IT IS NOT JUST BLANK,
#IF IT IS BLANK (ONLY HAS A SPACE) IT CAN BE SKIPPED;
if {[string map {" " ""} $DataValue] eq ""} {
set SkippedColFlag 1;
continue;
}
#IF A COLUMN HAS BEEN SKIPPED INDICATE IT ON THE COL INDEX;
if {$SkippedColFlag} {
append xml " <Cell ss:Index=\"$C\""
set SkippedColFlag 0;
} else {
append xml " <Cell"
}
#APPLY THE STYLE TO THE CELL IF THERE IS ONE DEFINED;
if {[info exist Data(${workbook}.WS${WS}.$R.$C.-s)]} {
append xml " ss:StyleID=\"[lindex [split $Data(${workbook}.WS${WS}.$R.$C.-s) .] 1]\""
} elseif {[info exist ColStyle(${workbook}.WS${WS}.$C.-s)]} {
#IF THERE IS NO CELL STYLE APPLY THE COLUMN STYLE IF ONE EXIST;
append xml " ss:StyleID=\"[lindex [split $ColStyle(${workbook}.WS${WS}.$C.-s) .] 1]\""
} elseif {0} {
#if there is a row style.
}
append xml ">"
#DETERMINE THE FORMAT OF THE DATA POSSIBLE VALUES ARE: DateTime Number String
switch -regexp -matchvar DataList -- $DataValue {
^(0?[1-9]|[12][0-9]|3[01])[-[:space:]\\/\.](0?[1-9]|1[012])[-[:space:]\\/\.]((?:19|20)?[0-9]{2})$ {
#DMY
lassign $DataList Full Day Month Year
if {[string length $Year] == 2} {
if {$Year <= 20} {
#ASSUME THAT WE ARE REFERENCING THE 21ST CENTURY;
set Year "20$Year"
} else {
#ASSUME THAT THE USER IS REFERENCING THE 20TH CENTURY;
set Year "19$Year"
}
}
set NomalizedDate [clock scan $Month/$Day/$Year -format {%m/%d/%Y}]
append xml "<Data ss:Type=\"DateTime\">[clock format $NomalizedDate -format {%Y-%m-%dT00:00:00.000}]</Data></Cell>\n"
}
^(0?[1-9]|1[012])[-[:space:]\\/\.](0?[1-9]|[12][0-9]|3[01])[-[:space:]\\/\.]((?:19|20)?[0-9]{2})$ {
#MDY
puts $DataList
lassign $DataList Full Month Day Year
if {[string length $Year] == 2} {
if {$Year <= 20} {
#ASSUME THAT WE ARE REFERENCING THE 21ST CENTURY;
set Year "20$Year"
} else {
#ASSUME THAT THE USER IS REFERENCING THE 20TH CENTURY;
set Year "19$Year"
}
}
set NomalizedDate [clock scan $Month/$Day/$Year -format {%m/%d/%Y}]
append xml "<Data ss:Type=\"DateTime\">[clock format $NomalizedDate -format {%Y-%m-%dT00:00:00.000}]</Data></Cell>\n"
}
^((?:19|20)[0-9]{2})[-[:space:]\\/\.](0?[1-9]|1[012])[-[:space:]\\/\.](0?[1-9]|[12][0-9]|3[01])$ {
#YMD
lassign $DataList Full Year Month Day
if {[string length $Year] == 2} {
if {$Year <= 20} {
#ASSUME THAT WE ARE REFERENCING THE 21ST CENTURY;
set Year "20$Year"
} else {
#ASSUME THAT THE USER IS REFERENCING THE 20TH CENTURY;
set Year "19$Year"
}
}
set NomalizedDate [clock scan $Month/$Day/$Year -format {%m/%d/%Y}]
append xml "<Data ss:Type=\"DateTime\">[clock format $NomalizedDate -format {%Y-%m-%dT00:00:00.000}]</Data></Cell>\n"
}
^[-]?[0-9]*\.?[0-9]+$ {
append xml "<Data ss:Type=\"Number\">$DataValue</Data></Cell>\n";
}
default {
append xml "<Data ss:Type=\"String\">[string map {\" " ' ' < < > > & &} $DataValue]</Data></Cell>\n";
}
}
#END THE SWITCH STATEMENT FOR STING TYPE;
} else {
#NO DATA EXIST IN THIS COLUMN, SKIP IT AND SET FLAG;
set SkippedColFlag 1;
set PrevNumber $C
}
}
#END COLUMN LOOP;
append xml " </Row>\n"
} else {
set SkippedRowFlag 1
}
}
#END ROW LOOP;
append xml " </Table>\n"
append xml " </Worksheet>\n"
}
#END WORKSHEET LOOP;
append xml " <WorksheetOptions xmlns=\"urn:schemas-microsoft-com:office:excel\">\n"
append xml " <PageSetup>\n"
append xml " <Header x:Margin=\"0.3\"/>\n"
append xml " <Footer x:Margin=\"0.3\"/>\n"
append xml " <PageMargins x:Bottom=\"0.75\" x:Left=\"0.7\" x:Right=\"0.7\" x:Top=\"0.75\"/>\n"
append xml " </PageSetup>\n"
append xml " <Unsynced/>\n"
append xml " <Print>\n"
append xml " <ValidPrinterInfo/>\n"
append xml " <HorizontalResolution>600</HorizontalResolution>\n"
append xml " <VerticalResolution>600</VerticalResolution>\n"
append xml " </Print>\n"
append xml " <Selected/>\n"
append xml " <Panes>\n"
append xml " <Pane>\n"
append xml " <Number>3</Number>\n"
append xml " <ActiveRow>1</ActiveRow>\n"
append xml " <ActiveCol>1</ActiveCol>\n"
append xml " </Pane>\n"
append xml " </Panes>\n"
append xml " <ProtectObjects>False</ProtectObjects>\n"
append xml " <ProtectScenarios>False</ProtectScenarios>\n"
append xml " </WorksheetOptions>\n"
append xml "</Workbook>\n"
} else {
error "At least one Worksheet must exist in the workbook"
}}
#INITILIZE THE DEFAULT VALUES FOR COLUMN INDEX; Tcl2ExXML::_CreateColIdx