wm title . "Tcl TCOM Excel Input Program" wm resizable . 0 0 wm protocol . WM_DELETE_WINDOW closem
package require tcom
set excel ::tcom::ref createobj Excel.Application $excel Visible 0 set workbooks $excel Workbooks if { file exists "C:\\test.xls" != 1 } {
set workbook [$workbooks Add]
$workbook SaveAs {C:\test.xls}
}set workbook $workbooks Open {C:\test.xls} set worksheets $workbook Worksheets set worksheet $worksheets Item [expr 1] set cells [$worksheet Cells set sheet 1 set EMPTY "" set goto 1 set NODEFAULTROWS 999
set start 1 ## Example: set start 7
set numberoffields 7
## Example: set numberoffields 3
set labels {"Header 1: "\ "Header 2: "\ "Header 3: "\ "Header 4: "\ "Header 5: "\ "Header 6: "\ "Header 7: "}
## Example: #set labels {"First name: "\ #"Last name:"\ #"Extension: "}
set howmany "" set textvariables "" set columns "" for { set y 1 } {$y <= $numberoffields } { incr y} {
lappend howmany $y
lappend textvariables "entry$y"
switch $y {
1 { lappend columns "A" }
2 { lappend columns "B" }
3 { lappend columns "C" }
4 { lappend columns "D" }
5 { lappend columns "E" }
6 { lappend columns "F" }
7 { lappend columns "G" }
8 { lappend columns "H" }
9 { lappend columns "I" }
10 { lappend columns "J" }
11 { lappend columns "K" }
12 { lappend columns "L" }
13 { lappend columns "M" }
14 { lappend columns "N" }
15 { lappend columns "O" }
default {}
}}foreach Number $howmany Label $labels Variable $textvariables {
label .l$Number -text $Label -font { helvetica 9 bold} -relief flat
entry .e$Number -textvariable $Variable -font { helvetica 9 } -width 40}
label .message -text "Message: " -relief ridge -font { helvetica 9 bold } label .error -width 50 -textvariable ErrorMsg -relief ridge -bg #efffff
for { set Number 1 } { $Number <= $numberoffields } { incr Number } {
grid .l$Number -row $Number -column 1 -sticky e
grid .e$Number -row $Number -column 2 -sticky ew
}grid .message -row 10 -column 1 -sticky e grid .error -row 10 -column 2 -sticky ew
frame .f2 button .f2.b1 -text "GoTo" -bg lightblue -font { helvetica 9 bold } -command {
set ErrorMsg ""
if { $goto >= 1 && $goto <= $NODEFAULTROWS } {
foreach Column $columns DataSource $textvariables {
set $DataSource [[$cells Item $goto $Column] Value]
}} else {
set ErrorMsg "Number has to be between 1 and $NODEFAULTROWS"
foreach DataSource $textvariables {
set $DataSource ""
}}
.f2.b2 configure -state active -activebackground lightblue
.f2.b3 configure -state active -activebackground lightblue
}entry .f2.e1 -width 5 -text 1 -textvariable goto -font {elvetica 9 }
button .f2.b1a -text "Next" -bg lightblue -font { helvetica 9 bold } -command {
set ErrorMsg ""
incr goto
if { $goto >= 1 && $goto <= $NODEFAULTROWS } {
foreach Column $columns DataSource $textvariables {
set $DataSource [[$cells Item $goto $Column] Value]
}
.f2.b2 configure -state active -activebackground lightblue
.f2.b3 configure -state active -activebackground lightblue
} else {
set goto 1
set ErrorMsg "Number has to be between 1 and $NODEFAULTROWS"
foreach DataSource $textvariables {
set $DataSource ""
}
.f2.b2 configure -state disabled -bg lightblue
.f2.b3 configure -state disabled -bg lightblue
}}button .f2.b1b -text "Back" -bg lightblue -font { helvetica 9 bold } -command {
set ErrorMsg ""
set goto [expr $goto - 1 ]
if { $goto >= 1 && $goto <= $NODEFAULTROWS } {
foreach Column $columns DataSource $textvariables {
set $DataSource [[$cells Item $goto $Column] Value]
}
.f2.b2 configure -state active -activebackground lightblue
.f2.b3 configure -state active -activebackground lightblue
} else {
set goto 1
set ErrorMsg "Number has to be between 1 and $NODEFAULTROWS"
foreach DataSource $textvariables {
set $DataSource ""
}
.f2.b2 configure -state disabled -bg lightblue
.f2.b3 configure -state disabled -bg lightblue
}}button .f2.b2 -state disabled -text "Replace" -bg lightblue -fg black -disabledforeground blue \
-font { helvetica 9 bold } -command {
if {$entry1 != "" } {
if { $goto >= 1 && $goto <$NODEFAULTROWS } {
foreach Column $columns DataSource $textvariables {
$cells Item $goto $Column [expr $$DataSource]
set $DataSource ""
}
.f2.b2 configure -state disabled -bg lightblue
.f2.b3 configure -state disabled -bg lightblue
} else {
set ErrorMsg "Number has to be between 1 and $NODEFAULTROWS"
set goto 1
.f2.b2 configure -state disabled -bg lightblue
.f2.b3 configure -state disabled -bg lightblue
}} else {
set ErrorMsg "First Field is required!"
}}button .f2.b3 -state disabled -text "Delete" -bg lightblue -fg black -disabledforeground blue \
-font { helvetica 9 bold } -command {
if { $goto >= 1 && $goto <$NODEFAULTROWS } {
foreach Column $columns DataSource $textvariables {
$cells Item $goto $Column $EMPTY
set $DataSource ""
}
.f2.b2 configure -state disabled -bg lightblue -fg black
.f2.b3 configure -state disabled -bg lightblue -fg black
} else {
set ErrorMsg "Number has to be between 1 and $NODEFAULTROWS"
set goto 1
.f2.b2 configure -state disabled -bg lightblue -fg black
.f2.b3 configure -state disabled -bg lightblue -fg black
}}
button .f2.b3a -text "Delete Last" -bg lightblue -font { helvetica 9 bold } -command {
for { set Row [expr $start + 1 ] } { $Row <= $NODEFAULTROWS } { incr Row } {
if { [[$cells Item $start A ] Value ] == "" } {
set Row 999999
set ErrorMsg "No records to delete from Excel Sheet $sheet!"
} else {
if { [[$cells Item $Row A] Value ] == "" } {
set Row [ expr $Row - 1 ]
foreach Column $columns DataSource $textvariables {
$cells Item $Row $Column $EMPTY
set $DataSource ""
}
set ErrorMsg "Deleted last entry from Excel Sheet $sheet!"
set Row 999999
}}}}button .f2.b4 -text "Add record" -bg lightblue -font { helvetica 9 bold } -command {
set goto 1
.f2.b2 configure -state disabled -bg lightblue
.f2.b3 configure -state disabled -bg lightblue
set ErrorMsg ""
for { set Row $start} { $Row <= $NODEFAULTROWS } { incr Row } {
if { [[$cells Item $Row A] Value ] == "" } {
if {$entry1 != "" } {
foreach Column $columns DataSource $textvariables {
$cells Item $Row $Column [expr $$DataSource]
set $DataSource ""
}
set Row 999999
set ErrorMsg "Adding record to Excel Sheet $sheet!"
} else {
set ErrorMsg "First Field is required"
set Row 999999
}}}
update
}pack .f2.b1 -side left pack .f2.e1 -side left pack .f2.b1a -side left pack .f2.b1b -side left pack .f2.b2 -side left pack .f2.b3 -side left pack .f2.b3a -side left pack .f2.b4 -side left
grid .f2 -row 19 -column 1 -columnspan 2
frame .f1 button .f1.b2 -text "Tab it" -bg lightgreen -font { helvetica 9 bold } -command {
set line ""
set fp1 [ open "C:\\test.txt" w+ ]
for { set Row $start} { $Row <= $NODEFAULTROWS } { incr Row } {
if { [[$cells Item $Row A] Value ] == "" } {
set Row 999999
} else {
set line ""
foreach Column $columns {
set line $line[[$cells Item $Row $Column] Value]\t
}
regsub {\t$} $line "" line
puts $fp1 "$line"
}}
flush $fp1
close $fp1
}button .f1.b2a -text "Comma it" -bg lightgreen -font { helvetica 9 bold } -command {
set line ""
set fp1 [ open "C:\\test.cvs" w+ ]
for { set Row $start } { $Row <= $NODEFAULTROWS } { incr Row } {
if { [[$cells Item $Row A] Value ] == "" } {
set Row 999999
} else {
set line ""
foreach Column $columns {
set line $line[[$cells Item $Row $Column] Value],
}
regsub {,$} $line "" line
puts $fp1 "$line"
}}
flush $fp1
close $fp1
}button .f1.b2b -text "Show xls" -bg lightgreen -font { helvetica 9 bold } -command {
if {[$excel Visible] == 1} {
$excel Visible 0
} else {
$excel Visible 1
}}button .f1.b2c -text "Backup" -bg lightgreen -font { helvetica 9 bold } -command {
set ErrorMsg "Backup only copies original file that you started with!"
file copy -force "C:\\test.xls" "C:\\testbak.xls"
}button .f1.b2d -text "Clear" -bg lightgreen -font { helvetica 9 bold } -command {
set ErrorMsg ""
set goto 1
.f2.b2 configure -state disabled -bg lightblue
.f2.b3 configure -state disabled -bg lightblue
foreach DataSource $textvariables {
set $DataSource ""
}}button .f1.b2f -text "Change Sheets" -bg lightgreen -font { helvetica 9 bold } -command {
if { $sheet == 1 } {
set worksheet [$worksheets Item [expr 2]]
set cells [$worksheet Cells]
set sheet 2
set ErrorMsg "You are now using Sheet 2 - select proper Excel Tab to view"
} elseif { $sheet == 2 } {
set worksheet [$worksheets Item [expr 3]]
set cells [$worksheet Cells]
set sheet 3
set ErrorMsg "You are now using Sheet 3 - select proper Excel Tab to view"
} else {
set worksheet [$worksheets Item [expr 1]]
set cells [$worksheet Cells]
set sheet 1
set ErrorMsg "You are now using Sheet 1 - select proper Excel Tab to view"
}}
button .f1.b3 -text "Quit" -bg pink -font { helvetica 9 bold } -command {
$excel Visible 0
$excel Quit
unset excel
exit 0
}pack .f1.b2 -side left pack .f1.b2a -side left pack .f1.b2b -side left pack .f1.b2c -side left pack .f1.b2d -side left pack .f1.b2f -side left pack .f1.b3 -side left
grid .f1 -row 20 -column 1 -columnspan 2
proc closem { } {
global excel
$excel Quit
unset excel
exit 0}