个人博客 用于记载日常收集的一些技术文章 ...

K3 BOS : VB 程序 返回值 K3 BOS : VB 程序 返回值 Module myfunctions

Sub Main()
Dim a As Integer = 100
Dim b As Integer = 200
Dim res As Integer

res = FindMax(a, b) '调用程序 并 返回值

Console.WriteLine("Max value is : {0}", res)
Console.ReadLine()
End Sub

Function FindMax(ByVal num1 As Integer, ByVal num2 As Integer) As Integer

Dim result As Integer
If (num1 > num2) Then
result = num1
Else
result = num2
End If
FindMax = result
End Function

End Module 郭少锋 创建 2023-03-30 20:25:33 K3 BOS SQL : SQL 合并 相同数据 distinct SQL : SQL 合并 相同数据 distinct -- 分组 合并 相同数据 distinct = GROUP BY id ,age

select distinct id ,age
from (
select 1 id ,20 age union
select 1 id ,20 age union
select 1 id ,16 age union

select 2 id ,16 age union

select 3 id ,15 age union
select 3 id ,15 age
) a1

/* 结果：

id age
1 16
1 20
2 16
3 15
*/ 郭少锋 编辑 2023-03-30 14:33:14 创建 2023-02-09 22:43:54 SQL K3 BOS : K3 下推/选单时 数据检查 K3 BOS : K3 下推/选单时 数据检查 Private WithEvents m_ListInterface As ListEvents '定义 ListEvents 接口. 必须具有的声明, 以此来获得事件

Private Sub Class_Terminate() '释放接口对象 '注意: 此方法必须存在, 请勿修改

Set m_ListInterface = Nothing
End Sub

Private Sub m_ListInterface_MenuBarClick(ByVal BOSTool As K3ClassEvents.BOSTool, Cancel As Boolean)

Dim vctSelectedBillInfo As KFO.Vector, rs As ADODB.Recordset
Dim sSql As String, i As Long

Select Case BOSTool.ToolName

Case "mnuPushOldBill_1", "mnuBackData" 'mnuPushOldBill_1 下推 1 外购入库 mnuBackData 选单

Set vctSelectedBillInfo = m_ListInterface.GetSelectedBillInfo

sSql = "select distinct FFetchAdd from t_BOS200000003 where "

For i = 1 To vctSelectedBillInfo.Size

If Not i = vctSelectedBillInfo.Size Then
sSql = sSql & "FID=" & vctSelectedBillInfo(i)("FID") & " or "
Else
sSql = sSql & "FID=" & vctSelectedBillInfo(i)("FID")
End If
Next

Set rs = m_ListInterface.K3Lib.GetData(sSql)

If rs.RecordCount > 1 Then

MsgBox "所选单据交货地点必须相同", vbCritical, m_ListInterface.K3Lib.LoadKDString("金蝶提示")

Cancel = True '取消 下推操作
End If

Case Else
End Select

Set vctSelectedBillInfo = Nothing
Set rs = Nothing
End Sub 郭少锋 编辑 2023-03-29 21:20:07 创建 2023-03-27 20:59:50 K3 BOS K3 BOS : K3 单据 修改字段值 K3 BOS : K3 单据 修改字段值 Private Sub aFill()

Dim oHeads As K3ClassEvents.BillHeads: Set oHeads = m_BillInterface.BillHeads
Dim oHead As K3ClassEvents.BillHead: Set oHead = oHeads(1)

Dim oEntrys As K3ClassEvents.BillEntrys: Set oEntrys = m_BillInterface.BillEntrys
Dim oEntry As K3ClassEvents.BillEntry: Set oEntry = oEntrys(1)


Dim oFields As K3ClassEvents.BOSFields: Set oFields = oHead.BOSFields
Dim oField As K3ClassEvents.BOSField: Set oField = oFields("FNOTE") '【FNOTE 备注】

With oField
.Value = "单元格被锁定了" '修改值
.FieldLock = True '锁定字段
End With


Set oFields = oEntry.BOSFields: Set oField = oFields("FBase4") '【FBase4 物料】
With oField
.Number = "1.01.001" '修改值
End With

Set oHeads = Nothing
Set oHead = Nothing
Set oEntrys = Nothing
Set oEntry = Nothing
Set oFields = Nothing
Set oField = Nothing

m_BillInterface.SetFieldValue "FQty", 20, 1 '第1行 FQty = 20

m_BillInterface.InsertNewRowAndFill 2, 2, "FPrice", 6.35 '在 page2 第2行之前 插入行 FPrice = 6.35

m_BillInterface.InsertNewRowAndFill 2, 1, "FBase4", "1.01.100-0088-002", "FQty", 40, "FPrice", 2.65 '在 page2 第1行之前 插入行

End Sub 郭少锋 创建 2023-03-29 21:15:04 K3 BOS K3 BOS : K3 菜单事件 K3 BOS : K3 菜单事件 Private Sub m_BillInterface_MenuBarClick(ByVal BOSTool As K3ClassEvents.BOSTool, Cancel As Boolean) '菜单事件

Select Case BOSTool.ToolName

Case "MyMenu": aFill '填写数值
Case "MenuWG": aOpenBill '打开单据 指定的外购入库单

Case Else
End Select

End Sub

Private Sub aOpenBill() '打开单据 指定的外购入库单

Dim aK3BosActive As Object
Dim aFInterID As Long
Dim aSql As String

Dim aRecordset As ADODB.Recordset

aSql = "select top 1 FInterID from ICStockBillEntry where FSourceTranType=" & m_BillInterface.FID & " and FSourceInterId =" & m_BillInterface.Data("FID")
Set aRecordset = m_BillInterface.K3Lib.GetData(aSql)

If aRecordset.RecordCount > 0 Then

aFInterID = CLng(aRecordset("FInterID").Value)
Set aK3BosActive = CreateObject("K3BosActive.Application")

aK3BosActive.ShowK3Bill -1, aFInterID 'Bill.FClassTypeID = -1 / Bill.FID = aFInterID BOS单据 对应ICClassType的FID；工业单据 对应ICTransType的FID（要取负数）

' aK3BosActive.ShowK3Bill 1007105, 1016 'Bill.FClassTypeID = 1007105 / Bill.FID = 1016 委外订单（BOS）

Else
MsgBox "没有关联的入库单"

End If

Set aK3BosActive = Nothing
Set aRecordset = Nothing
End Sub
郭少锋 编辑 2023-03-29 21:13:58 创建 2023-03-29 21:13:17 K3 BOS K3 BOS : K3 单据体操作 K3 BOS : K3 单据体操作 当前行数 = 单据体总行数 且 输入的 物料代码 = 1.01.100-0088-000P 且 数量 > 0 ，在这行的下面插入5行 并 填写 物料，数量

Private Sub m_BillInterface_Change(ByVal dct As KFO.IDictionary, ByVal dctFld As KFO.IDictionary, ByVal Col As Long, ByVal Row As Long, Cancel As Boolean) '单据数据改变后触发

Dim sValue As String
Dim sItemNumber As String
Dim dbQty As Double

If Row = m_BillInterface.Data("page2").Size Then '当前行数 = 单据体总行数

sValue = m_BillInterface.Data("page2")(Row)(m_BillInterface.TableInfo("Map")("FBase4"))("FFND") '当前行 物料.代码
If Len(sValue) > 0 Then
sItemNumber = sValue
Else
Exit Sub '退出 Sub 程序
End If

sValue = m_BillInterface.Data("page2")(Row)(m_BillInterface.TableInfo("Map")("FQty"))("FFLD") '当前行 数量.值
If Len(sValue) > 0 And IsNumeric(sValue) Then
dbQty = CDbl(sValue)
Else
Exit Sub
End If

If sItemNumber = "1.01.100-0088-000P" And dbQty > 0 Then '物料代码 = 1.01.100-0088-000P + 数量 > 0

m_BillInterface.InsertNewRowAndFill 2, Row + 1, "FBase4", "1.01.100-0088-001", "FQty", dbQty * 2 '插入新行 填写数据 2, = page2 / Row + 1 行号 / "FBase4", "1.01.100-0088-001" 字段Key 字段值 / "FQty", dbQty * 2 字段Key 字段值
m_BillInterface.InsertNewRowAndFill 2, Row + 2, "FBase4", "1.01.100-0088-002", "FQty", dbQty * 2
m_BillInterface.InsertNewRowAndFill 2, Row + 3, "FBase4", "1.01.100-0088-003", "FQty", dbQty * 1
m_BillInterface.InsertNewRowAndFill 2, Row + 4, "FBase4", "1.01.100-0088-004", "FQty", dbQty * 1
m_BillInterface.InsertNewRowAndFill 2, Row + 5, "FBase4", "1.01.100-0088-005", "FQty", dbQty * 1
End If
End If
End Sub 郭少锋 编辑 2023-03-29 21:08:16 创建 2023-03-29 21:07:50 K3 BOS K3 BOS : K3 单据插件 K3 BOS : K3 单据插件
Option Explicit '强制声明变量 Dim sValue As String


Private WithEvents m_BillInterface As BillEvent '定义 BillEvent 接口. 必须具有的声明, 以此来获得事件
Attribute m_BillInterface.VB_VarHelpID = -1


Public Sub Show(ByVal oBillInterface As Object) 'BillEvent 接口实现 注意: 此方法必须存在, 请勿修改

Set m_BillInterface = oBillInterface
End Sub

Private Sub Class_Terminate() '释放接口对象 '注意: 此方法必须存在, 请勿修改

Set m_BillInterface = Nothing
End Sub




Private Sub m_BillInterface_AfterLoadBill() '单据加载后事件

'----------------------------------------------------------------------------------
Dim sKey As String: sKey = m_BillInterface.TableInfo("Map")("FTime")
Dim sValue As String: sValue = m_BillInterface.Data("page1")(sKey)("FFLD")

Dim dtValue As Date

If Len(sValue) > 0 Then '用 Len 来比较，速度比 = Null 快
dtValue = CDate(sValue) '文本转日期
End If
'----------------------------------------------------------------------------------

sKey = m_BillInterface.TableInfo("Map")("FQty")
sValue = m_BillInterface.Data("page2")(1)(sKey)("FFLD") '取得字段值

Dim dbQty As Double

If Len(sValue) > 0 And IsNumeric(sValue) Then
dbQty = CDbl(sValue) '文本转数字
End If

MsgBox "审核日期为：" & dtValue & " 第一行实收数量为：" & dbQty

'---------------------------------------------------------------------------------
m_BillInterface.BillEntrys(1).MaxRows = 2000 '单据最大行数扩充至2000

End Sub


Private Sub m_BillInterface_AfterNewBill() '单据新增时触发

m_BillInterface.BillEntrys(1).MaxRows = 2000 '单据最大行数扩充至2000
End Sub

郭少锋 创建 2023-03-29 21:02:39 K3 BOS K3 BOS : K3 打开序时簿 K3 BOS : K3 打开序时簿 Private Sub aListProduce(aFID As String)

Dim oDataSrv As Object
Dim oBillLookUp As Object
Dim dctFilter As KFO.Dictionary
Dim sKey As String

Set dctFilter = New KFO.Dictionary
Set oBillLookUp = CreateObject("K3ClassLookUp.BillLookUp")
Set oDataSrv = CreateObject("K3ClassTpl.DataSrv")

' oDataSrv.ClassTypeID = 210001401 '要打开的目标单据序时薄的单据类型ID
oBillLookUp.ClassTypeID = 210001401 '要打开的目标单据序时薄的单据类型ID

dctFilter("HeadSort") = ""
dctFilter("EntrySort") = ""

dctFilter("FilterString") = "FID_Src in ( " & aFID & " )" '传递的过滤条件，比如按指定单据内码进行过滤
dctFilter("SelectPage") = "1,2," '显示单据头、单据体1

' If oDataSrv.TableInfo("PageCount") >= 2 Then 'BOS单据有多个单据体，序时薄只展示一个单据体，所以需要指定打开的序时薄显示哪个单据体
' dctFilter("SelectPage") = "1,2," '显示单据头、单据体1
' Else
' dctFilter("SelectPage") = "1," '只显示单据头
' End If

oDataSrv.Filter = dctFilter '将过滤条件

Set oBillLookUp.DataSrv = oDataSrv: oBillLookUp.Show

Set oBillLookUp = Nothing
Set oDataSrv = Nothing
Set dctFilter = Nothing
End Sub
郭少锋 创建 2023-03-27 23:24:48 K3 BOS K3 BOS : K3 序时簿 当前选中的行 K3 BOS : K3 序时簿 当前选中的行 Private Sub m_ListInterface_MenuBarClick(ByVal BOSTool As K3ClassEvents.BOSTool, Cancel As Boolean) '菜单事件

Dim aSelRow As Dictionary, aFEntryId As String: Set aSelRow = m_ListInterface.GetCurrentSelRowInfo

aFEntryId = aSelRow("FEntryId")
aFID = aSelRow("FID")

End Sub
郭少锋 编辑 2023-03-27 21:05:07 创建 2023-03-27 20:44:58 K3 BOS K3 BOS : K3 序时簿只显示 当前用户 所属部门 的数据 K3 BOS : K3 序时簿只显示 当前用户 所属部门 的数据 Private WithEvents m_ListInterface As ListEvents '定义 ListEvents 接口. 必须具有的声明, 以此来获得事件

Private Sub Class_Terminate() '释放接口对象 '注意: 此方法必须存在, 请勿修改

Set m_ListInterface = Nothing
End Sub



Public Sub Show(ByVal oListInterface As Object) 'ListEvents 接口实现 '注意: 此方法必须存在, 请勿修改

Set m_ListInterface = oListInterface

Dim lDeptID As Long
Dim rs As ADODB.Recordset
Dim sSql As String

sSql = " select t1.FDepartmentID from t_Emp t1 inner join t_user t2 on t1.FItemID=t2.FEmpID " & _
" where t2.FUserID=" & m_ListInterface.K3Lib.User.UserID

Set rs = m_ListInterface.K3Lib.GetData(sSql)

If rs.RecordCount > 0 Then
lDeptID = CLng(rs("FDepartmentID").Value)
End If

m_ListInterface.ListFilterString = "t_BOS200000003.FDeptID=" & lDeptID '过滤条件 只允许看到本部门的单据
m_ListInterface.RefreshList
End Sub
郭少锋 创建 2023-03-27 20:56:31 K3 BOS