?? frmexport.frm
字號:
Begin XCOMBOXLib.XCombox cmbTable
Height = 300
Left = 1440
TabIndex = 10
Top = 315
Width = 1950
_Version = 65536
_ExtentX = 3440
_ExtentY = 300
_StockProps = 68
End
Begin VB.CommandButton cmdNext2
Caption = "下一步"
Height = 375
Left = 5805
TabIndex = 1
Top = 4770
Width = 1050
End
Begin VB.Label Label7
AutoSize = -1 'True
Caption = "選擇表:"
Height = 195
Left = 765
TabIndex = 11
Top = 360
Width = 585
End
End
Begin VB.Frame Frame
Caption = "步驟3."
Height = 5415
Index = 3
Left = 1215
TabIndex = 7
Top = 2250
Width = 7350
Begin MSComctlLib.ProgressBar ProgressBar
Height = 240
Left = 1035
TabIndex = 9
Top = 2385
Width = 5145
_ExtentX = 9075
_ExtentY = 423
_Version = 393216
Appearance = 1
End
Begin VB.CommandButton cmdFinish
Caption = "完成"
Height = 375
Left = 4905
TabIndex = 8
Top = 3150
Width = 1050
End
End
End
Attribute VB_Name = "frmExport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim tmpCon As New ADODB.Connection '定義數據庫的連接
Dim rstGrid As New ADODB.Recordset
Dim rstExec As New ADODB.Recordset
Dim ExcelApp As Excel.Application
Dim ExcelSheet As Excel.Worksheet
Dim ExcelWorkbook As Excel.Workbook
Dim m_FilePath As String
Dim m_way As Boolean
Private Sub Check1_Click()
End Sub
Private Sub Check_Click()
End Sub
Private Sub cmbOnClass_BtnsClick(ByVal nIndex As Integer)
rstOnClass.Requery
bufOnClass.DataSource = rstOnClass
cmbOnClass.DataSource = bufOnClass
End Sub
Private Sub cmbTable_Selected()
Dim sTable As String
Dim i As Integer
Dim Index As Long
sTable = Trim(cmbTable.Text)
cmbName.DeleteAllItem
cmbCode.DeleteAllItem
cmbCard.DeleteAllItem
If LCase(Right(Trim(m_FilePath), 3)) = "xls" Then
If Not (ExcelSheet Is Nothing) Then Set ExcelSheet = Nothing
Set ExcelSheet = ExcelApp.ActiveWorkbook.Sheets(sTable)
'=====================cmbName=======================
For i = 1 To ExcelSheet.UsedRange.Columns.Count
If Trim(ExcelSheet.Cells(1, i)) <> "" Then
Index = cmbName.AddString(ExcelSheet.Cells(1, i) + vbLf)
cmbName.SetItemData Index, i
End If
Next
'=====================cmbCode=======================
For i = 1 To ExcelSheet.UsedRange.Columns.Count
If Trim(ExcelSheet.Cells(1, i)) <> "" Then
Index = cmbCode.AddString(ExcelSheet.Cells(1, i) + vbLf)
cmbCode.SetItemData Index, i
End If
Next
'=====================cmbCard=======================
For i = 1 To ExcelSheet.UsedRange.Columns.Count
If Trim(ExcelSheet.Cells(1, i)) <> "" Then
Index = cmbCard.AddString(ExcelSheet.Cells(1, i) + vbLf)
cmbCard.SetItemData Index, i
End If
Next
ElseIf LCase(Right(Trim(m_FilePath), 3)) = "mdb" Then
If rstExec.State = adStateOpen Then rstExec.Close
Set rstExec = Nothing
rstExec.CursorLocation = adUseClient
rstExec.Open "select top 1 * from " & sTable, tmpCon, adOpenStatic, adLockReadOnly
For i = 0 To rstExec.Fields.Count - 1 ' 循環所有列
cmbName.AddString rstExec.Fields(i).Name + vbLf '字段名
cmbCode.AddString rstExec.Fields(i).Name + vbLf
cmbCard.AddString rstExec.Fields(i).Name + vbLf
Next
End If
End Sub
Private Sub cmbVac_BtnsClick(ByVal nIndex As Integer)
rstVac.Requery
bufVac.DataSource = rstVac
cmbVac.DataSource = bufVac
End Sub
Private Sub cmdBack1_Click()
HideFrame
Frame(1).Visible = True
End Sub
Private Sub Form_Load()
Me.Icon = MDI.Icon
Me.Caption = "導入"
Dim i As Integer
For i = 1 To Frame.Count
Frame(i).Move 60, 60
Next
Option1 = True
Option3 = True
txtBaseVal.MaxTextLen = 8
txtBaseVal.Type = sNumber
Me.Width = Frame(2).Width + 200
Me.Height = Frame(2).Height + 600
HideFrame
Frame(1).Visible = True
End Sub
Private Sub SetOcx()
'=====================cmbName=======================
cmbTable.DeleteAllItem
cmbTable.ShowHeadScale = "0,20"
cmbTable.ShowHeadValue = "DataID,表"
cmbTable.ShowIndex = 1
cmbTable.Type = tNormal
cmbTable.DropWidth = cmbName.Width \ 15
'=====================cmbName=======================
cmbName.DeleteAllItem
cmbName.ShowHeadScale = "0,20"
cmbName.ShowHeadValue = "DataID,某例"
cmbName.ShowIndex = 1
cmbName.Type = tNormal
cmbName.DropWidth = cmbName.Width \ 15
'=====================cmbCode=======================
cmbCode.DeleteAllItem
cmbCode.ShowHeadScale = "0,20"
cmbCode.ShowHeadValue = "DataID,某例"
cmbCode.ShowIndex = 1
cmbCode.Type = tNormal
cmbCode.DropWidth = cmbCode.Width \ 15
'=====================cmbCard=======================
cmbCard.DeleteAllItem
cmbCard.ShowHeadScale = "0,20"
cmbCard.ShowHeadValue = "DataID,某例"
cmbCard.ShowIndex = 1
cmbCard.Type = tNormal
cmbCard.DropWidth = cmbCard.Width \ 15
'=====================cmbVac=======================
cmbVac.DeleteAllItem
cmbVac.ShowHeadScale = "0,20"
cmbVac.ShowHeadValue = "VacID,休假名稱"
cmbVac.ShowIndex = 1
cmbVac.Type = tStatic
cmbVac.SetBtns "刷新"
cmbVac.ButtonHeight = 20
cmbVac.DropWidth = cmbVac.Width \ 15
Set cmbVac.DataSource = bufVac
'=====================cmbOnClass=======================
cmbOnClass.DeleteAllItem
cmbOnClass.ShowHeadScale = "0,20"
cmbOnClass.ShowHeadValue = "OnClassID,排班名稱"
cmbOnClass.ShowIndex = 1
cmbOnClass.Type = tStatic
cmbOnClass.SetBtns "刷新"
cmbOnClass.ButtonHeight = 20
cmbOnClass.DropWidth = cmbOnClass.Width \ 15
Set cmbOnClass.DataSource = bufOnClass
End Sub
Private Sub cmdNext1_Click()
On Error GoTo openErr
If Trim(txtPath.Text) = "" Then
Message "請選擇文件!"
Exit Sub
End If
If Dir(Trim(txtPath.Text)) = "" Then
Message "文件不存在!"
Exit Sub
End If
m_FilePath = Trim(txtPath.Text)
SetOcx
If LCase(Right(Trim(m_FilePath), 3)) = "xls" Then
If Not (ExcelWorkbook Is Nothing) Then Set ExcelWorkbook = Nothing
If Not (ExcelApp Is Nothing) Then Set ExcelApp = Nothing
Set ExcelApp = CreateObject("Excel.Application")
Set ExcelWorkbook = ExcelApp.Workbooks.Open(m_FilePath)
cmbTable.DeleteAllItem
Dim i As Integer
For i = 1 To ExcelWorkbook.Sheets.Count
cmbTable.AddString ExcelWorkbook.Sheets.Item(i).Name + vbLf
Next
ElseIf LCase(Right(Trim(m_FilePath), 3)) = "mdb" Then
Dim strSQL As String
Dim rstSchema As ADODB.Recordset
strSQL = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & m_FilePath & " ;Persist Security Info=False"
If tmpCon.State = 1 Then tmpCon.Close
tmpCon.Open strSQL
Set rstSchema = tmpCon.OpenSchema(adSchemaTables)
Do Until rstSchema.EOF
cmbTable.AddString rstSchema!TABLE_NAME + vbLf
rstSchema.MoveNext
Loop
If rstSchema.State = 1 Then rstSchema.Close
Set rstSchema = Nothing
End If
HideFrame
Frame(2).Visible = True
Exit Sub
openErr:
If InStr(Err.Description, "密碼無效") <> 0 Then
Message "請先去掉密碼再導入!"
Exit Sub
End If
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -