基本介紹
- 軟體名稱：Excel辦公軟體
- 開發商：微軟
- 軟體語言：英文
- 程式控制控制項：ComCalcu
用品簡介,運行環境,VB控制界面組成,操作步驟,操作程式,
用品簡介
用VB6控制Excel處理數據Excel辦公軟體用起來並非真是如此那么簡單，要隨心所欲運用之並非易事，總有人被Excel的INDEX結果顯示整得雲裡霧裡（還有很多問題喔！）。最近，試著打造“VB+Excel”，期望推出“傻瓜型”數據處理“小件”，已有所小成。現以調用Excel中的LINEST（多元線性回歸函式）為例。
運行環境
VB控制界面組成
數據輸入控制項：TextDataNum（數據組數輸入TextBox），TextFacNum（參數個數輸入TextBox），TextInput（實驗數用VB6控制Excel處理數據
用VB6控制Excel處理數據
用VB6控制Excel處理數據據輸入中介TextBox），GridIn（實驗數據表格MSFlexGrid）；
結果輸出控制項：LabTRV（回歸相關係數顯示Label），LabTEV（回歸總體方差顯示Label），GridOut（各參數回歸係數、標準誤差顯示表格MSFlexGrid）；
程式控制控制項：ComCalcu（程式執行按鈕CommandButton）；
其它控制項從略。
操作步驟
操作步驟簡述如下：
⒈引用Microsoft Excel類型庫
“工程”-“引用”-選擇“Microsoft Excel 8.0 Object Library”-“確定”
⒉聲明顯式數據類型，創建新實例並獲取Excel的控制句柄
Dim ExcelObject As Excel.Application
Set ExcelObject = CreateObject("Excel.Application")
⒊調用並顯示Excel
Excelobject.Visible = True
由於Excel啟動為不可見，在編程調試過程中，需要監測之，完工後最好Rem。
⒋將GridIn中的數據送入Excel
⒌Excel對數據進行多元回歸
⒍將Excel運算結果輸入GridOut，LabTRV 和LabTEV
⒎最後交還Excel控制句柄
Set ExcelObject = Nothing
此方法也可直接控制其他大量套用軟體，可從你的Object Library略知一二。
操作程式
部分源程式代碼如下：
通用聲明
Dim DNum As Integer ' DNum數據組數
Dim FNum As Integer ' FNum參數個數
Dim ExcelObject As Excel.Application
表格初始化
--DataGRidMK 'GridIn製作模組
Sub DataGRidMK()
DNum = Val(Me.TextDataNum.Text)
FNum = Val(Me.TextFacNum.Text)
With Me.GridIn
.Cols = FNum + 2
.Rows = DNum + 1
End With
With Me.GridIn
.Row = 0
.Col = 0: .Text = " 實驗數據"
.Col = 1: .Text = " 測值Y"
For i = 1 To .Cols - 1
.ColWidth(i) = 1200
Next i
For i = 2 To .Cols - 1
.Col = i
.Text = " 參數 X" & (i - 1）
Next i
For i = 1 To .Rows - 1
.Col = 0
.Row = i: .Text = " " & i
Next i
End With
End Sub
--DataInitial '隨機產生GridIn數據模組
Sub DataInitial() '隨機產生表格數據
Randomize Timer
With Me.GridIn
For i = 1 To .Rows - 1
.Row = i
For j = 1 To .Cols - 1
.Col = j
.Text = Rnd * 500 \ 1
Next j
Next i
End With
End Sub
為方便程式調式，實驗數據採用隨機產生；也可自行修改/輸入，從略
--GridOutMK 'GridOut製作模組
Sub GridOutMK()
With Me.GridOut
.Cols = FNum + 2
.Rows = 3
End With
With Me.GridOut
.Row = 0
.Col = 0: .Text = " 回歸輸出"
.Col = 1: .Text = " Const"
.Row = 1: .Col = 0: .Text = " 係數Ai"
.Row = 2: .Col = 0: .Text = " 相關係數"
For i = 1 To .Cols - 1
.ColWidth(i) = 1200
Next i
.Row = 0
For i = 2 To .Cols - 1
.Col = i
.Text = " 參數 X" & (i - 1）
Next i
End With
End Sub
回歸運算
Private Sub ComCalcu_Click()
' GridOut清空
With Me.GridOut
For i = 1 To .Rows - 1
.Row = i
For j = 1 To .Cols - 1
.Col = j
.Text = ""
Next j
Next i
End With
'LabTEV，LabTRV處於等待狀態
With Me.LabTEV
.BackColor = vbBlue
End With
With Me.LabTRV
.BackColor = vbBlue
End With Dim SA As String,Sb$,Sc$
Set ExcelObject = CreateObject("Excel.Application") '創建新實例
'Excelobject.Visible = True '顯示調用
ExcelObject.Workbooks.Add '添加新工作簿
Sb = "B" & Format$(DNum)
Sc = Chr$（65 + FNum) & Format$(DNum)
'表格數據送入Excel
For i = 1 To DNum
Me.GridIn.Row = i
For j = 1 To FNum + 1
Me.GridIn.Col = j
If Me.GridIn.Text = "" Then
MsgBox "實驗數據有空缺，請補充完整。",vbOKOnly,"警告"
With Me.LabTEV
.Caption = "#VALUE"
.BackColor = &HC0C0C0
End With
With Me.LabTRV
.Caption = "#VALUE"
.BackColor = &HC0C0C0
End With
'Set Excelobject = Nothing
Exit Sub
End If
SA = Chr$（64 + j) & Format$(i)
ExcelObject.Range(SA).Value = Me.GridIn.Text
Next j
Next i
'回歸運算
Dim Ip,P As String '定位回歸結果顯示單元格
For i = 1 To 2
Ip = Format$(i + DNum) 'i=1時在第Dnum+1行顯示係數，i=2時在第Dnum+2行 顯示標準誤差
For j = 1 To FNum + 1
P = Chr$（64 + j) & Ip
ExcelObject.Range(P).Formula="=INDEX(LINEST($A:$A$"& Format$(DNum)
& ",$B:$" & Chr$（65 + FNum) & "$" & Format$(DNum) & ",1,1），" &
Format$(i) & "," & Format$(j) & ")"
Next j
Next i
P = "A" & Format$(DNum + 3） '定位
ExcelObject.Range(P).Formula = "=INDEX(LINEST($A:$A$" & Format$(DNum) & ",$B:$" & Chr$（65 + FNum) & "$" & Format$(DNum) & ",1,1），3,1）" '相關係數
P = "B" & Format$(DNum + 3） '定位
ExcelObject.Range(P).Formula = "=INDEX(LINEST($A:$A$" & Format$(DNum) & ",$B:$" & Chr$（65 + FNum) & "$" & Format$(DNum) & ",1,1），3,2）" '總體方差
'顯示回歸結果至GridOut
With Me.GridOut
'顯示Const係數
.Row = 1: .Col = 1
P = Chr$（64 + FNum + 1） & Format$(DNum + 1）
.Text = Format$(ExcelObject.Range(P).Value,"0.0000")
'顯示Const標準誤差
.Row = 2: .Col = 1
P = Chr$（64 + FNum + 1） & Format$(DNum + 2）
.Text = Format$(ExcelObject.Range(P).Value,"0.0000")
For i = 1 To FNum
'顯示係數
.Row = 1
P = Chr$（64 + i) & Format$(DNum + 1）
.Col = FNum - i + 2
.Text = Format$(ExcelObject.Range(P).Value,"0.0000")
'顯示標準誤差
.Row = 2
P = Chr$（64 + i) & Format$(DNum + 2）
.Col = FNum - i + 2
.Text = Format$(ExcelObject.Range(P).Value,"0.0000")
Next i
End With
'顯示總體相關係數
P = "A" & Format$(DNum + 3）
Me.LabTRV.Caption = Format$(ExcelObject.Range(P).Value,"0.0000")
'顯示總體方差
P = "B" & Format$(DNum + 3）
Me.LabTEV.Caption = Format$(ExcelObject.Range(P).Value,"0.0000")
With Me.LabTEV
.BackColor = &HC0C0C0
End With
With Me.LabTRV
.BackColor = &HC0C0C0
End With
Set ExcelObject = Nothing
End Sub
