📄 frmimport.frm
字号:
End If
Next
cmdOK_Click = True
EndProc:
Me.MousePointer = vbDefault
End Function
Private Function PathValid() As Boolean
Dim i As Long
Dim j As Long
Dim lngCount As Long
For i = 1 To GrdCol.Rows - 1
If GrdCol.TextMatrix(i, 1) <> "" Then
lngCount = 1
For j = i - 1 To 1 Step -1
If GrdCol.RowHeight(j) <> 0 Then
If GrdCol.TextMatrix(j, 1) <> "" Then
If RowPropertys(GrdCol.RowData(i)).strPath = RowPropertys(GrdCol.RowData(j)).strPath Then
Exit For
End If
End If
lngCount = lngCount + 1
End If
Next
If j = 0 Then
If Dir(RowPropertys(GrdCol.RowData(i)).strPath, vbDirectory) = "" Then
cMsgBox "第" & lngCount & "行的路径不存在,请重新选择!", "数据导入"
Exit Function
End If
End If
End If
Next
PathValid = True
End Function
Private Function ImportItems(ByVal lngRow As Long) As Boolean
Dim i As Long
Dim blnItems(100) As Boolean
For i = lngRow To GrdCol.Rows - 1
If GrdCol.TextMatrix(i, 1) <> "" Then
If RowPropertys(GrdCol.RowData(i)).strPath = RowPropertys(GrdCol.RowData(lngRow)).strPath Then
blnItems(ItemName2NO(RowPropertys(GrdCol.RowData(i)).strData(2))) = True
End If
End If
Next
AccountImport RowPropertys(GrdCol.RowData(lngRow)).strPath & "\format.ini", blnItems
End Function
Private Function ItemName2NO(ByVal strItemName As String) As Long
Select Case strItemName
Case "货币"
ItemName2NO = 0
Case "科目"
ItemName2NO = 1
Case "部门"
ItemName2NO = 2
Case "职员类别"
ItemName2NO = 3
Case "职员"
ItemName2NO = 4
Case "单位类别"
ItemName2NO = 5
Case "单位"
ItemName2NO = 6
Case "统计核算"
ItemName2NO = 7
Case "项目核算"
ItemName2NO = 8
Case "商品性质"
ItemName2NO = 9
Case "商品类别"
ItemName2NO = 10
Case "商品"
ItemName2NO = 11
Case "商品单位"
ItemName2NO = 12
Case "货位"
ItemName2NO = 13
Case "工程类别"
ItemName2NO = 14
Case "工程"
ItemName2NO = 15
Case "自定义项目0"
ItemName2NO = 16
Case "自定义项目1"
ItemName2NO = 17
Case "自定义项目2"
ItemName2NO = 18
Case "自定义项目3"
ItemName2NO = 19
Case "自定义项目4"
ItemName2NO = 20
Case "自定义项目5"
ItemName2NO = 21
Case "凭证类别"
ItemName2NO = 22
Case "单据模板"
ItemName2NO = 23
Case "固资方式"
ItemName2NO = 24
Case "固资类别"
ItemName2NO = 25
Case "企业收发地址"
ItemName2NO = 26
Case "企业开户银行"
ItemName2NO = 27
Case "单位收发地址"
ItemName2NO = 28
Case "单位开户银行"
ItemName2NO = 29
Case "凭证"
ItemName2NO = 30
Case "余额"
ItemName2NO = 31
Case "科目期初"
ItemName2NO = 32
Case "应收应付余额"
ItemName2NO = 33
Case "应收应付期初"
ItemName2NO = 34
Case "现金银行余额"
ItemName2NO = 35
Case "银行对帐单"
ItemName2NO = 36
Case "银行帐期初"
ItemName2NO = 37
Case "固资变动"
ItemName2NO = 38
Case "财务预算"
ItemName2NO = 39
Case "经营预算"
ItemName2NO = 40
Case "采购订单"
ItemName2NO = 41
Case "商品采购"
ItemName2NO = 42
Case "直运采购"
ItemName2NO = 43
Case "受托入库"
ItemName2NO = 44
Case "受托结算"
ItemName2NO = 45
Case "加工入库"
ItemName2NO = 46
Case "加工费用"
ItemName2NO = 47
Case "采购发票"
ItemName2NO = 48
Case "自制入库"
ItemName2NO = 49
Case "盘盈入库"
ItemName2NO = 50
Case "其他入库"
ItemName2NO = 51
Case "销售订单"
ItemName2NO = 52
Case "商品销售"
ItemName2NO = 53
Case "直运销售"
ItemName2NO = 54
Case "委托出库"
ItemName2NO = 55
Case "委托结算"
ItemName2NO = 56
Case "加工出库"
ItemName2NO = 57
Case "分期出库"
ItemName2NO = 58
Case "分期结算"
ItemName2NO = 59
Case "销售发票"
ItemName2NO = 60
Case "领用出库"
ItemName2NO = 61
Case "成本调整"
ItemName2NO = 62
Case "盘亏出库"
ItemName2NO = 63
Case "其他出库"
ItemName2NO = 64
Case "代销调拨"
ItemName2NO = 66
Case "商品调拨"
ItemName2NO = 68
Case "商品调价"
ItemName2NO = 69
Case "商品组装"
ItemName2NO = 70
Case "商品拆卸"
ItemName2NO = 71
Case "商品盘点"
ItemName2NO = 73
Case "应付贷项"
ItemName2NO = 74
Case "应付借项"
ItemName2NO = 75
Case "应收借项"
ItemName2NO = 76
Case "应收贷项"
ItemName2NO = 77
Case "应收计息"
ItemName2NO = 78
Case "付款单"
ItemName2NO = 79
Case "收款单"
ItemName2NO = 80
Case "库存期初"
ItemName2NO = 82
Case "受托期初"
ItemName2NO = 83
Case "委托期初"
ItemName2NO = 84
Case "分期期初"
ItemName2NO = 85
Case "直运期初"
ItemName2NO = 86
Case "加工期初"
ItemName2NO = 87
Case "暂估期初"
ItemName2NO = 92
Case "固资期初"
ItemName2NO = 93
Case "拜访客户资料"
ItemName2NO = 94
Case "现金项目"
ItemName2NO = 95
Case "地区"
ItemName2NO = 96
End Select
End Function
Private Sub ShowAll()
Dim i As Long
Dim blnRedrawBak As Boolean
blnRedrawBak = GrdCol.Redraw
GrdCol.Redraw = False
If chkShowALL.Value = 0 Then
For i = 1 To GrdCol.Rows - 1
If RowPropertys(GrdCol.RowData(i)).strData(9) <> "" Then
SetSelectRow i, False
GrdCol.RowHeight(i) = 0
Else
GrdCol.RowHeight(i) = 270
End If
Next
Else
For i = 1 To GrdCol.Rows - 1
If GrdCol.RowHeight(i) = 0 Then
SetSelectRow i, False
GrdCol.RowHeight(i) = 270
End If
Next
End If
For i = 1 To GrdCol.Rows - 1
If GrdCol.RowHeight(i) <> 0 Then
GrdCol.Row = i
Exit For
End If
Next
SetButtonEnabled
GrdCol.Redraw = blnRedrawBak
End Sub
Private Sub SetButtonEnabled()
Dim i As Long
Dim blnButtonEnabled(6) As Boolean
With GrdCol
blnButtonEnabled(3) = True
blnButtonEnabled(4) = True
blnButtonEnabled(5) = True
blnButtonEnabled(6) = True
If .Rows = 1 Then
blnButtonEnabled(3) = False
blnButtonEnabled(4) = False
blnButtonEnabled(5) = False
blnButtonEnabled(6) = False
GoTo EndProc
End If
If .Rows = 2 Then
If .RowHeight(1) = 0 Then
blnButtonEnabled(3) = False
blnButtonEnabled(4) = False
End If
blnButtonEnabled(5) = False
blnButtonEnabled(6) = False
GoTo EndProc
End If
If .Row = 1 Then
blnButtonEnabled(5) = False
End If
If .Row = .Rows - 1 Then
blnButtonEnabled(6) = False
End If
If chkShowALL.Value = 0 Then
blnButtonEnabled(3) = False
blnButtonEnabled(4) = False
For i = 1 To .Row - 1
If .RowHeight(i) <> 0 Then
blnButtonEnabled(3) = True
blnButtonEnabled(4) = True
Exit For
End If
Next
If i = .Row Then
blnButtonEnabled(5) = False
End If
For i = .Row + 1 To .Rows - 1
If .RowHeight(i) <> 0 Then
blnButtonEnabled(3) = True
blnButtonEnabled(4) = True
Exit For
End If
Next
If i = .Rows Then
blnButtonEnabled(6) = False
End If
If .RowHeight(.Row) > 0 Then
blnButtonEnabled(5) = True
blnButtonEnabled(6) = True
End If
End If
End With
EndProc:
cmdOkCancel(3).Enabled = blnButtonEnabled(3)
cmdOkCancel(4).Enabled = blnButtonEnabled(4)
' cmdOkCancel(5).Enabled = blnButtonEnabled(5)
' cmdOkCancel(6).Enabled = blnButtonEnabled(6)
Erase blnButtonEnabled
End Sub
Private Sub GrdCol_RowColChange()
' SetButtonEnabled
End Sub
Private Sub RowExchange(Optional ByVal blnUp As Boolean = True)
Dim i As Long, lngRowDes As Long
Dim strDataTmp As String
With GrdCol
For i = 1 To .Cols - 1
.TextMatrix(0, i) = ColName(i)
Next
If blnUp Then
For i = .Row - 1 To 1
If .RowHeight(i) <> 0 Then
Exit For
End If
Next
If i <> 0 Then
lngRowDes = i
End If
Else
For i = .Row + 1 To .Rows - 1
If .RowHeight(i) <> 0 Then
Exit For
End If
Next
If i <> .Rows Then
lngRowDes = i
End If
End If
If lngRowDes <> 0 Then
.Redraw = False
For i = 0 To .Cols - 1
strDataTmp = .TextMatrix(lngRowDes, i)
.TextMatrix(lngRowDes, i) = .TextMatrix(.Row, i)
.TextMatrix(.Row, i) = strDataTmp
Next
strDataTmp = .RowData(lngRowDes)
.RowData(lngRowDes) = .RowData(.Row)
.RowData(.Row) = C2lng(strDataTmp)
.Redraw = True
.Row = lngRowDes
End If
End With
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -