kishorkhanal
Active Member
- Joined
- Mar 23, 2006
- Messages
- 434
I have an excel spreadsheet which is supposed to work with another software called winwedge. Winwedge sends data to excel. The excel file is downloaded for winwedge v.3 from following website:
http://www.taltech.com/support/dde_sw/saveconf.htm
Here is the excel file code module. Whenever I send data from the gauge, the data should appear in excel. Whenever I send data, the excel spreadsheet hangs. Please suggest what might have gone wrong. Please let me know if you have any questions.
http://www.taltech.com/support/dde_sw/saveconf.htm
Here is the excel file code module. Whenever I send data from the gauge, the data should appear in excel. Whenever I send data, the excel spreadsheet hangs. Please suggest what might have gone wrong. Please let me know if you have any questions.
Code:
' TAL Technologies, Inc.
' 2027 Wallace Street
' Philadelphia PA 19130
' Tel: 800-722-6004, 215-763-5096
' Fax: 215-763-9711
' Email: sales@taltech.com
' Website: http://www.taltech.com
' The Following Code Collects Data from Sylvac Caliper
' Using The TAL Technologies' WinWedge Program and Places the Data
' in appropriate columns and plots the data in a chart.
' This code was authored by Tom Lutz
' and was created on 03/23/98.
' Last Updated: 12/20/2001
'________________________________________________________________________________________________
' Declare the Findwindow API function used in the 16 bit and 32 bit FindWedge routine
Declare Function FindWindow16 Lib "user" Alias "FindWindow" (ByVal lpClassName As Any, ByVal lpWindowName As String) As Integer
Declare Function FindWindow32 Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As String) As Long
' Declare the following variables as global variables
Global Myport As String
Global selectedcomport As Integer
Global directorylocation As String
Global rowpointer As Integer
Global cancelvalue As Integer
'________________________________________________________________________________________________
' This subroutine runs when the spreadsheet is opened the first time.
' it it checks to see if the resolution is less than 800 by 600, if so it warns
' the user that this spreadsheet is best viewed under 800 by 600 resolution
' Then it it displays the setup form, if the user presses the cancel Button on the spreadsheet
' The cleardata, request multiple recored, request one record button are
' hidden and the user is warned that the spreadsheet is not setup properly to begin
' data collection
Sub Auto_Open()
Worksheets("Sheet1").Activate ' Activate the sheet
If Windows(1).VisibleRange.Cells.Count < 180 Then ' If the screen resolution is less than 800 by 600
Beep ' Tell the user that this spreadsheet is best viewed at 800 by 600 resolution
MsgBox "This worksheet is best viewed full screen using a screen resolution of 800 by 600 or higher.", 48
End If
Setup ' Run the setup subroutine
If cancelvalue = 1 Then ' If cancel was pressed
ActiveSheet.Buttons("Button 5").Visible = False ' Hide the cleardata Button
ActiveSheet.Buttons("Button 4").Visible = False ' Hide the multiplerecord Button
ActiveSheet.Buttons("Button 3").Visible = False ' Hide the onerecord Button
Beep
' Warn the user that the spreadsheet is not setup properly, and to run setup to begin data collection
MsgBox "This Spreadsheet is not setup properly to collect data " _
& "from WinWedge. Click the Setup " _
& "button and choose the correct COM port that your gage is connected to, " _
& "and the correct path to your WinWedge Directory.", , "Error"
Exit Sub ' Exit the subroutine
End If
' If cancel was not pressed on the setup form, then
' Set the caption of mode label to "Mode"
Worksheets("sheet1").Unprotect ' Unprotect the sheet
ActiveSheet.Buttons("Button 3").Visible = True ' Make the Onerecord Button Visible
ActiveSheet.Buttons("Button 4").Visible = True ' Make the multiplerecord Button Visible
ActiveSheet.Buttons("Button 5").Visible = True ' Hide the cleardata Button
ActiveSheet.Buttons("Button 4").Text = "Request Multiple Samples" ' Set the text to "Request Multiple Samples"
Worksheets("sheet1").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
'________________________________________________________________________________________________
' This subroutine runs when the user closes the workbook, it simply looks to see if the wedge
' is running, if so it closes the wedge
Sub Auto_Close()
If Val(Application.Version) < 7 Then ' If the version of excel is less than 7
FindWedge16 ' Call the findwedge16 routine
Else ' If not
FindWedge32 ' Call the findwedge32 routine
End If
Sheets("Sheet1").Cells(16, 7).Formula = ""
If Myport <> "" Then ' If Myport = ""
ActiveWorkbook.SetLinkOnData "WinWedge|" + Myport + "Field(1)", ""
chan = DDEInitiate("winwedge", Myport) ' Open a DDE link to the wedge
DDEExecute chan, "[appexit]" ' Send the DDE command that kills the wedge
End If
End Sub
'________________________________________________________________________________________________
' This routine is called by the the wedge, whenever it receives new data from the gage
' The routine gets the data from the wedge and places it in the
' spreadsheet with a date and time stamp and then calls a routine to update the chart
Sub GetData()
Sheets("Sheet1").Activate
If rowpointer = 0 Then rowpointer = 17 ' If the rowpointer is 0 set it = 17
If Myport = "" Then: Exit Sub ' If Myport is not defined, exit the sub
chan = DDEInitiate("winwedge", Myport) ' Open a DDE channel
F1 = DDERequest(chan, "field(1)") ' Request the data from field one in the wedge
Wedgedata$ = F1(1) ' Convert the data to a string
DDETerminate chan ' Close the DDE channel
If Wedgedata$ = "" Then Exit Sub
Sheets("Sheet1").Cells(rowpointer, 1).Formula = Wedgedata$ ' Place the data in cell rowpointer, 3
Sheets("Sheet1").Cells(rowpointer, 2).Formula = Date ' Place the date in cell rowpointer, 1
Sheets("Sheet1").Cells(rowpointer, 3).Formula = Time$ ' Place the time in cell rowpointer, 2
rowpointer = rowpointer + 1 ' Increment the rowpointer
UpdateChart ' Update the chart
End Sub
'________________________________________________________________________________________________
' This subroutine launches the wedge with the specified configuration
Sub LaunchWedge()
Dim retval As Long ' Declare the retval variable as long
On Error GoTo 0 'Resume Next ' Turn off error trapping
' check for file VBRUN100.DLL that only comes with WinWedge Standard edition.
If Len(Dir(directorylocation & "\vbrun100.dll")) Then FoundStdWedge% = True
' Build WinWedge Pro configuration file name and path (SW3 file)
cfgFile$ = directorylocation & "\fowler" & Format$(selectedcomport) & ".SW3"
' Look for a configuration file for WinWedge Pro (v3.0)
If (Len(Dir(cfgFile$)) = 0) Or FoundStdWedge% Then
' If we do not find a WinWedge Pro file, look for a WinWedge Standard file (v1.2)
cfgFile$ = directorylocation & "\fowler" & Format$(selectedcomport) & ".SW1"
If Len(Dir(cfgFile$)) = 0 Then
Beep ' config file was not found then make some noise
MsgBox ("Cannot find the necessary WinWedge configuration file in the directory you specified.")
On Error GoTo 0 ' reset error trapping
Exit Sub ' exit
End If
End If
cmdline$ = directorylocation & "\WINWEDGE.EXE " & cfgFile$
'The line below lauches the WinWedge with the specified configuration file
retval = Shell(cmdline$)
Success% = False
TenSecsFromNow = Now + TimeValue("00:00:10") ' give wedge time to load
WindowString$ = "Software Wedge - COM" & Format$(selectedcomport) & Chr$(0)
WindowString2$ = "WinWedge - COM" & Format$(selectedcomport) & Chr$(0)
Do
DoEvents ' Allow other processes to run
If Val(Application.Version) < 7 Then ' If the version of Excel is less than 7
Iwindowhwnd% = FindWindow16(0&, WindowString$) ' Look for WinWedge window using 16 bit API call
If Iwindowhwnd% <> 0 Then Success% = True: Exit Do ' If found then exit the loop successfully
Iwindowhwnd% = FindWindow16(0&, WindowString2$) ' Look for WinWedge window using 16 bit API call
If Iwindowhwnd% <> 0 Then Success% = True: Exit Do ' If found then exit the loop successfully
Else ' If Excel version is >=7 then use 32 bit API
windowhwnd& = FindWindow32(0&, WindowString$)
If windowhwnd& <> 0 Then Success% = True: Exit Do
windowhwnd& = FindWindow32(0&, WindowString2$)
If windowhwnd& <> 0 Then Success% = True: Exit Do
End If
Loop While Now < TenSecsFromNow
AppActivate Application.Caption ' Set the focus back to Excel
Sheets("Sheet1").Cells(17, 1).Select
If Not Success% Then
Beep ' If shell command returned a zero
MsgBox "WinWedge did not load sucessfully.", , "Error"
End If
On Error GoTo 0 ' Turn on error trapping
End Sub
'________________________________________________________________________________________________
' This subroutine tries determines which version of Excel that the user is running
' and based on that it calls another function to see if the wedge is running.
' and if the wedge is not running it calls the launchwedge function to launch the wedge.
' If the wedge is running, but the user chose to run the wedge on a different com port
' than the one the current wedge is running at. Then this routine closes the current
' wedge and launches a new instance of the wedge for the newly selected com port.
Sub FindWedge()
Dim newlyselectedcomport As String
selectedcomport = Sheets("sheet1").Cells(2, 3).Value
newlyselectedcomport = "COM" & selectedcomport
If Val(Application.Version) < 7 Then ' If the version of excel is less than 7
FindWedge16 ' Call the findwedge16 routine
Else ' If not
FindWedge32 ' Call the findwedge32 routine
End If
If Myport = "" Then ' If Myport = ""
LaunchWedge ' Try to launch the wedge
Myport = "COM" & Sheets("sheet1").Cells(2, 3).Value
ElseIf newlyselectedcomport <> Myport Then ' If Myport <> to newlyselectedcomport
chan = DDEInitiate("WinWedge", Myport) ' close the wedge that is open currently
DDEExecute chan, "[appexit]"
DDETerminate chan
LaunchWedge ' then launch the wedge with the new comport
End If
End Sub
'________________________________________________________________________________________________
' This subroutine tries to find the WinWedge and identify
' the port that it has been activated on (for 32 bit Windows)
Sub FindWedge32()
On Error GoTo 0
For x% = 1 To 4
Myport = "COM" + LTrim$(Str$(x%))
WindowString$ = "Software Wedge - " & Myport & Chr$(0)
WindowString2$ = "WinWedge - " & Myport & Chr$(0)
windowhwnd& = FindWindow32(0&, WindowString$)
If windowhwnd& = 0 Then
windowhwnd& = FindWindow32(0&, WindowString2$)
End If
If windowhwnd& <> 0 Then
Myport = "COM" & Format$(x%)
Exit For
End If
Next
If windowhwnd& = 0 Then
Myport = "" ' set MyPort to null to indicate that wedge was not found
End If
End Sub
'________________________________________________________________________________________________
' This subroutine tries to find the WinWedge and identify
' the port that it has been activated on (for 16 bit Windows)
Sub FindWedge16()
On Error GoTo 0
For x% = 1 To 4
Myport = "COM" + LTrim$(Str$(x%))
WindowString$ = "Software Wedge - " & Myport & Chr$(0)
WindowString2$ = "WinWedge - " & Myport & Chr$(0)
Iwindowhwnd% = FindWindow16(0&, WindowString$)
If Iwindowhwnd% = 0 Then
Iwindowhwnd% = FindWindow16(0&, WindowString2$)
End If
If Iwindowhwnd% <> 0 Then
Myport = "COM" & Format$(x%)
Exit For
End If
Next
If Iwindowhwnd% = 0 Then
Myport = "" ' set MyPort to null to indicate that wedge was not found
End If
End Sub
'________________________________________________________________________________________________
' This subroutine updates the chart
Sub UpdateChart()
Worksheets("sheet1").Unprotect ' Unprotect the spreadsheet
' If there is data in cell C17, then update the chart
If Sheets("Sheet1").Range("C17") <> "" Then
Worksheets(1).ChartObjects("Chart 1").Chart. _
SeriesCollection(1).Values = "=Sheet1!R17C1:R" & rowpointer - 1 & "C1"
End If ' Protect the spreadsheet
Sheets("Sheet1").Cells(17, 5).Formula = "=Min(R17C1:R" & Format$(rowpointer - 1) & "C1)"
Sheets("Sheet1").Cells(18, 5).Formula = "=Max(R17C1:R" & Format$(rowpointer - 1) & "C1)"
Sheets("Sheet1").Cells(19, 5).Formula = "=TrimMean(R17C1:R" & Format$(rowpointer - 1) & "C1,0)"
' Sheets("Sheet1").Cells(20, 5).Formula = "=Average(R17C1:R" & Format$(rowpointer - 1) & "C1)"
Sheets("Sheet1").Cells(20, 5).Formula = "=Median(R17C1:R" & Format$(rowpointer - 1) & "C1)"
Sheets("Sheet1").Cells(21, 5).Formula = "=StDevP(R17C1:R" & Format$(rowpointer - 1) & "C1)"
Sheets("Sheet1").Cells(22, 5).Formula = "=AveDev(R17C1:R" & Format$(rowpointer - 1) & "C1)"
Sheets("Sheet1").Cells(23, 5).Formula = "=VarP(R17C1:R" & Format$(rowpointer - 1) & "C1)"
Worksheets("sheet1").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
'________________________________________________________________________________________________
' This subroutine prompts the gage for a single reading.
Sub SingleRecord()
If WedgeIsActive Then ' If the Wedge is Active
chan = DDEInitiate("winwedge", Myport) ' Open a DDE channel
DDEExecute chan, "[TOGGLEDTR]" 'send a prompt to the device
DDETerminate chan ' Close the DDE channel
End If
End Sub
'________________________________________________________________________________________________
' This subroutine runs when the user clicks on the "Record All Records"
' Button. This subroutine toggles the timer controlled output
Sub MultipeRecords()
If WedgeIsActive Then
Worksheets("sheet1").Unprotect ' Unprotect the spreadsheet
' Check to see if the caption of the button is "Record All Results"
If ActiveSheet.Buttons("Button 4").Text = "Request Multiple Samples" Then
chan = DDEInitiate("winwedge", Myport) ' Open a DDE link to the wedge
DDEExecute chan, "[Timer-On]" ' Send the DDE command that turns the timer controlled output "ON"
DDETerminate chan ' Close the DDE link
ActiveSheet.Buttons("Button 4").Text = " Stop Collecting Data"
' the above line changes the caption of the button to "Stop Record"
Else
chan = DDEInitiate("winwedge", Myport) ' Open a DDE link to the wedge
DDEExecute chan, "[Timer-Off]" ' Send the DDE command that turns the timer controlled output "OFF"
DDETerminate chan ' Close the DDE link
ActiveSheet.Buttons("Button 4").Text = "Request Multiple Samples"
' the above line changes the caption of the button to "Record All Results"
End If
Worksheets("sheet1").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True ' Protect the spreadsheet
End If
End Sub
'________________________________________________________________________________________________
' This function is called by the above two subroutines to make sure
' That the wedge is running. If the wedge is not runnning this routine
' Warns the user that the wedge is not running, and the operation
' they attempted to run could not be run.
Function WedgeIsActive() As Integer
If Val(Application.Version) < 7 Then ' If the version of excel is less than 7
FindWedge16 ' Call the findwedge16 routine
Else ' If not
FindWedge32 ' Call the findwedge32 routine
End If
If Myport = "" Then ' If finwedge16 or 32 returned Myport= ""
Beep ' Warn the user
MsgBox "WinWedge is not active. If you would like to collect data " _
& "from your gage, activate the Wedge by clicking the Setup button in this worksheet.", , "Error"
WedgeIsActive = False ' return a function value of False
Exit Function ' Exit the function
Else
WedgeIsActive = True ' Wedge was found - return a value of True.
End If
End Function
'________________________________________________________________________________________________
' This subroutine clear the content of the spreadsheet,
' Sets rowpointer = 17,
Sub ClearData()
Worksheets("sheet1").Unprotect ' Unprotect the spreadsheet
Range("A17:C1000").ClearContents ' Select the range specified
Range("A17").Select ' Select cell "A17"
rowpointer = 17 ' Reset ChanBrowpointer = 17
Worksheets("sheet1").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True ' protect the spreadsheet
End Sub
'________________________________________________________________________________________________
' This Subroutine runs when the user clicks on the setup button.
' This routine obtains all the values that were selected the
' last time the setup form was opened from column 3 and displays
' those values as the default values.
Sub Setup()
' Obtain the directory, and selected comport
directorylocation = Sheets("sheet1").Cells(1, 3).Text
selectedcomport = Sheets("sheet1").Cells(2, 3).Value
' Based on the selected comport value, select the appropriate option buttons
Select Case selectedcomport
Case 1: DialogSheets("setup").OptionButtons("com1").Value = xlOn
Case 2: DialogSheets("setup").OptionButtons("com2").Value = xlOn
Case 3: DialogSheets("setup").OptionButtons("com3").Value = xlOn
Case 4: DialogSheets("setup").OptionButtons("com4").Value = xlOn
End Select
' Write the default directory value in the WinWedge directory text box.
DialogSheets("setup").EditBoxes("swdirectory").Text = directorylocation
DialogSheets("setup").Show ' Show the form.
End Sub
'________________________________________________________________________________________________
' This subroutine closes the setup form
Sub Cancel()
DialogSheets("setup").Hide ' Hide the setup dialog box
cancelvalue = 1 ' Set the global variable cancelvalue to 1
End Sub
'________________________________________________________________________________________________
' This subroutine runs when the user presses the OK button on the setup form
' It collects the comport and the wedge directory location information the user entered
' and verifies that the winwedge.exe file actually exists in the specified directory, and
' and writes the user entered parameters column 3 for future use.
Sub Ok()
' Obtain the directory where WinWedge is located
directorylocation = DialogSheets("setup").EditBoxes("swdirectory").Text
directorylocation = Trim$(directorylocation)
If directorylocation = "" Then ' If the user did not enter a directorylocation, warn them
Beep
MsgBox "Please enter the path to your Winwedge Directory", , "Error"
Exit Sub ' And exit the subroutine
End If
' Look for WinWedge.exe in the specified dir and clean up if necessary
directorylocation = GetWedgeDir(directorylocation)
If directorylocation = "" Then ' If winwedge.exe was not found, warn the user
Beep
MsgBox "WinWedge.Exe does not exist in the directory you specified. " _
& Chr(13) & "Please enter the correct directory or press Cancel.", , "Error"
Exit Sub
End If
' Find the comport selected
If (DialogSheets("setup").OptionButtons("com1").Value = xlOn) Then
selectedcomport = 1
ElseIf (DialogSheets("setup").OptionButtons("com2").Value = xlOn) Then
selectedcomport = 2
ElseIf (DialogSheets("setup").OptionButtons("com3").Value = xlOn) Then
selectedcomport = 3
ElseIf (DialogSheets("setup").OptionButtons("com4").Value = xlOn) Then
selectedcomport = 4
End If
' Paste the WinWedge directorylocation and the selected
' comport values into the following cells
Worksheets("sheet1").Unprotect ' Unprotect the spreadsheet
Sheets("sheet1").Cells(1, 3).Formula = directorylocation ' Write the new directorylocation into cell 3,1
Sheets("sheet1").Cells(2, 3).Formula = selectedcomport ' Write the new comport selected into cell 3,2
Worksheets("sheet1").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True ' Protect the spreadsheet
DialogSheets("setup").Hide ' Hide the form
FindWedge ' Try to find the wedge, if not found Launch it
Worksheets("sheet1").Unprotect ' Unprotect the spreadsheet
ActiveSheet.Buttons("Button 3").Visible = True ' Make the Onerecord Button Visible
ActiveSheet.Buttons("Button 4").Visible = True ' Make the Multiplerecord Button Visible
ActiveSheet.Buttons("Button 5").Visible = True ' Make the Cleardata Button Visible
ActiveSheet.Buttons("Button 4").Text = "Request Multiple Samples"
Range("A17").Select ' Select cell "A17"
Worksheets("sheet1").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
'______________________________________________________________________________________
' This function checks if the executable winwedge.exe file exists in the directory
' specified by the user. It returns the corrected directory path to the Wedge.
Function GetWedgeDir(WedgeDir As String) As String
On Error Resume Next
tempdirectory$ = UCase$(Trim(WedgeDir)) ' Trim any spaces and convert to all upper case
If Right$(tempdirectory$, 1) = "\" Then ' If the last char = "\", then concatenate
tempdirectory$ = tempdirectory$ & "WINWEDGE.EXE" ' "winwedge.exe" to the directory the user entered
ElseIf Right$(tempdirectory$, 12) = "WINWEDGE.EXE" Then ' If user entered full path to the Wedge then leave it alone
Else
tempdirectory$ = tempdirectory$ & "\WINWEDGE.EXE" ' Otherwise add "\WINWEDGE.EXE to the path the user entered
End If
testfile$ = Dir(tempdirectory$) ' use the Dir function to see if the file exists
If Len(testfile$) = 0 Then ' If testfile$ is empty, WinWedge was not found
GetWedgeDir = "" ' Set the returned value equal to False
Else
x = InStr(tempdirectory$, "\WINWEDGE.EXE") ' Wedge was found
GetWedgeDir = Mid$(tempdirectory$, 1, x - 1) ' Return only the directory path to the caller
End If
On Error GoTo 0
End Function
'___________________________________________________________________________________________
Sub ShowFileOpenDialog()
FileToOpen = Application.GetOpenFilename("Programs (*.exe), *.exe", , "Locate WinWedge.Exe")
If FileToOpen <> "False" Then
FileToOpen = UCase$(FileToOpen)
x = InStr(FileToOpen, "\WINWEDGE.EXE") ' Wedge was found
If x Then
FileToOpen = Mid$(FileToOpen, 1, x - 1) ' Return only the directory path to the caller
DialogSheets("setup").EditBoxes("swdirectory").Text = FileToOpen
Else
Beep
End If
End If
End Sub
