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.
wm title . "Tcl TCOM Excel Input Program" wm resizable . 0 0 wm protocol . WM_DELETE_WINDOW closem #[email protected] 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 }