Updated 2008-08-25 12:56:49 by dkf

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
   #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
   }