wm title . "Tcl TCOM Excel Input Program"
wm resizable . 0 0
wm protocol . WM_DELETE_WINDOW closem
#wjk@wjk.NOSPAMmv.com
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
########################################################################
############ User can edit the program information below ###############
########################################################################
##### Where to start input/delete - normally 1st row
##### You may want to start at a higher row number as some users
##### have a tendancy to use 1st few rows for title/key and non-related information etc.
##### which is pretty but not database related.
set start 1
## Example: set start 7
##### How many fields (columns) default shown here is 7 MAX is 15
set numberoffields 7
## Example: set numberoffields 3
##### What labels you wish to apply for the GUI - there should be same number
##### of labels as the number of fields above...
##### These can be modified to match your needs ie {"Last Name: " "First Name: " etc.}
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
}This was my first experience with tcom - The goal of this program was to be able to use it as a template to create other spreadsheet specific programs for entering data into a spreadsheet from which I was going to export data and import into a cleaner/larger spreadsheet. One word of caution: Do not open spreadsheet with another program at the same time. If you copy this to your PC, remember to get rid of the 3 leading spaces.
Getting started
Home • Recent changes • Help • Create new page • Search • Add comments
• Edit