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

K3 BOS : 获取 单据体行数 K3 BOS : 获取 单据体行数 m_BillInterface.Data("Page2").UBound

注意：最后一条可能是空记录，要判断(if 分录关键子段或必填字段<>"" then .....)。 郭少锋 创建 2023-04-06 21:13:10 K3 BOS K3 BOS : 更改表体中数量 K3 BOS : 更改表体中数量 m_BillInterface.SetFieldValue "FAuxQty", 500, 1 ' 数量 = 500，第1行 合计值没有被改变 郭少锋 编辑 2023-04-06 21:12:03 创建 2023-04-06 21:11:41 K3 BOS K3 BOS : K3 保存后 自动启动审核 K3 BOS : K3 保存后 自动启动审核 在AfterSave事件中使用以下代码
Dim bStatus As Boolean
bStatus = m_BillInterface.MultiCheckMgr.MultiCheckBill(m_BillInterface.Data("FID")) 郭少锋 创建 2023-04-06 21:10:30 K3 BOS K3 BOS : K3 只能删除和修改本人制作的单据 K3 BOS : K3 只能删除和修改本人制作的单据 Private Sub m_ListInterface_MenuBarClick(ByVal BOSTool As K3ClassEvents.BOSTool, Cancel As Boolean)
Dim lBillerID As Long
Dim strSQL As String
 Select Case BOSTool.ToolName
 Case "mnuEditDelete", "mnuEditModify"
       strSQL = "Select FBiller（当前单据制单人） From t_Sales（当前单据主表名） Where FID（当前单据主键子段）=" & m_ListInterface.GetCurrentSelRowInfo("FID")
        lBillerID = m_ListInterface.K3Lib.GetData(strSQL)(0)
        If m_ListInterface.K3Lib.User.UserID <> lBillerID Then
             MsgBox "只能删除和修改本人的单据", vbExclamation, "提示"
              Cancel = True
       End If
Case Else
End Select
End Sub 郭少锋 创建 2023-04-06 21:07:52 K3 BOS K3 BOS : K3 隐葳/锁定 菜单 K3 BOS : K3 隐葳/锁定 菜单 Private Sub m_BillInterface_MenuBarInitialize(ByVal oMenuBar As K3ClassEvents.MenuBar)

Dim oBand As K3ClassEvents.BOSBand
Dim oTool As K3ClassEvents.BOSTool

Set oBand = oMenuBar.BOSBands("mnuFile"): Set oTool = oBand.BOSTools("mnuFilePageSetup") '【 mnuFile 文件 】【 mnuFilePageSetup 页面设置 】
With oTool
.Visible = False '隐藏
End With

Set oBand = oMenuBar.BOSBands("BandToolBar"): Set oTool = oBand.BOSTools("mnuFilePrint") '【 BandToolBar 工具栏 】【 mnuFilePrint 打印 】
With oTool
.Enabled = False '锁定
End With

Set oTool = Nothing
Set oBand = Nothing
End Sub 郭少锋 编辑 2023-04-06 17:47:02 创建 2023-03-29 21:09:58 K3 BOS K3 BOS : VB 系统信息 K3 BOS : VB 系统信息 aIP = CreateObject("MSWinsock.Winsock").LocalIP '【计算机IP】 192.168.188.151
aComputerName = Environ("ComputerName") '【计算机名称】 K3-151
aUserName = Environ("UserName") '【当前用户名】 Administrator

aVersion = App.Major & "." & App.Minor & "." & App.Revision '当前程序 版本号 "23.405.2233"
-------------------------------------------------------------------------------------------------------------------------------
Debug.Print Environ("UserDomain") '【包含用户帐户的域名称】 K3-151

Debug.Print CreateObject("MSWinsock.Winsock").LocalIP '【计算机IP】 192.168.188.151

Debug.Print Environ("ComputerName") '【计算机名称】 K3-151
Debug.Print Environ("UserName") '【当前用户名】 Administrator

Debug.Print Environ("Temp") '【当前用户临时目录】 C:\Users\ADMINI~1\AppData\Local\Temp

Debug.Print Environ("ProgramFiles") '【应用程序目录】C:\Program Files (x86)
Debug.Print Environ("AllUsersProfile") '【用户配置文件】C:\ProgramData
Debug.Print Environ("AppData") '【应用程序 存储数据的位置】C:\Users\Administrator\AppData\Roaming

Debug.Print Environ("WinDir") '【系统根目录】C:\Windows
Debug.Print Environ("SystemRoot") '【系统根目录】C:\Windows
Debug.Print Environ("SystemDrive") '【系统根目录】C:

Debug.Print Environ("UserProfile") '【用户主目录】 C:\Users\Administrator
Debug.Print Environ("HomePath") '【用户主目录】 \Users\Administrator
Debug.Print Environ("HomeDrive") '【用户主目录】 C:

Debug.Print Environ("ComSpec") '【CMD位置】 C:\Windows\system32\cmd.exe

Debug.Print Environ("Number_Of_Processors") '【处理器 数目】 4
Debug.Print Environ("Processor_Architecture") '【处理器 芯片结构】 x86 ,IA64
Debug.Print Environ("Processor_Level") '【处理器 型号】 6

Debug.Print Environ("OS") '【操作系统类型】 Windows_NT
Debug.Print Environ("PathExt") '【可执行文件 扩展名】.COM;.EXE;.BAT;.CMD;.VBS;.VBE;.JS;.JSE;.WSF;.WSH;.MSC
Debug.Print Environ("Path") '【程序路径】C:\Windows\system32;C:\Windows;C:\Windows\System32\Wbem;C:\Windows\System32\WindowsPowerShell\v1.0\;C:\Program Files (x86)\Microsoft SQL Server\100\Tools\Binn\;C:\Program Files\Microsoft SQL Server\100\Tools\Binn\;C:\Program Files\Microsoft SQL Server\100\DTS\Binn\;C:\Program Files (x86)\Microsoft SQL Server\100\Tools\Binn\VSShell\Common7\IDE\;C:\Program Files (x86)\Microsoft Visual Studio 9.0\Common7\IDE\PrivateAssemblies\;C:\Program Files (x86)\Microsoft SQL Server\100\DTS\Binn\;C:\Program Files\IDM Computer Solutions\UltraEdit;C:\Program Files (x86)\Kingdee\K3ERP\KDSYSTEM

郭少锋 编辑 2023-04-06 00:09:37 创建 2023-04-05 23:17:27 K3 BOS K3 BOS : K3 修改 选单条件 K3 BOS : K3 修改 选单条件 Private Sub m_BillInterface_BeforeSelBills(ByVal lSelBillType As Long, ByVal oDatasrv As Object, ByVal dctLink As Object, sFilter As String, dctParam As Object)

aFCustId = m_BillInterface.GetFieldValue("FBase") '【FBase 客户名称 FCustId】
aFOrderNoCust = m_BillInterface.GetFieldValue("FText2") '【FText2 合同号 FOrderNoCust】

If lSelBillType = 210001201 Then '【销售订单】

If aFCustId <> "" Then
aFCustId = "AND ( a_SeOrder.FCustId = " & aFCustId & " ) "
End If

If aFOrderNoCust <> "" Then
aFOrderNoCust = "AND ( a_SeOrder.FOrderNoCust like '%" & aFOrderNoCust & "%' ) "
End If

sFilter = sFilter & aFCustId & aFOrderNoCust '【添加 选单条件】
End If
End Sub
郭少锋 创建 2023-04-05 14:59:26 K3 BOS K3 BOS : VB 文本替换 K3 BOS : VB 文本替换 Private Sub Command1_Click()
Dim strSj As String
Dim strTh As String
strSj = "VB使用Replace函数实现替换字符或字符串。"
strTh = "替换"
strSj = Replace(strSj, "Replace", strTh) ' 要替换的来源，要替换的内容，替换后的内容
Debug.Print strSj
End Sub

郭少锋 创建 2023-04-02 02:13:07 K3 BOS windows : Excel 查找字段值 windows : Excel 查找字段值 =LOOKUP(1,0/(A:A=D4),B:B)

A:A=D4 A:A 查找的范围 D4 要查找的值 B:B 返回值 所在的范围 郭少锋 编辑 2023-04-02 00:22:07 创建 2023-04-02 00:21:36 windows K3 BOS : K3 删除前 检查 是否已作废 K3 BOS : K3 删除前 检查 是否已作废 Private Sub m_ListInterface_MenuBarClick(ByVal BOSTool As K3ClassEvents.BOSTool, Cancel As Boolean) '菜单事件

'------------------------------------------------------------------------------------------------------------
'拼接 FID,FEntryId

Dim aSelect As KFO.Vector: Set aSelect = m_ListInterface.GetSelectedBillInfo

Dim aFClassTypeID As Long
Dim aUsePage As String
Dim aFID As String
Dim aFEntryId As String

Set aDataSrv = m_ListInterface.List.DataSrv: aFClassTypeID = aDataSrv.ClassTypeID: aUsePage = aDataSrv.ListUsePage: aFID = "": aFEntryId = ""
Set aDataSrv = Nothing

If aUsePage = ",1,2," Then
For i = 1 To aSelect.Size
If Not i = aSelect.Size Then
aFID = aFID & aSelect(i)("FID") & ","
aFEntryId = aFEntryId & aSelect(i)("FEntryId") & ","
Else
aFID = aFID & aSelect(i)("FID")
aFEntryId = aFEntryId & aSelect(i)("FEntryId")
End If
Next
Else
For i = 1 To aSelect.Size
If Not i = aSelect.Size Then
aFID = aFID & aSelect(i)("FID") & ","
Else
aFID = aFID & aSelect(i)("FID")
End If
Next
End If

'------------------------------------------------------------------------------------------------------------
' 按钮名称

Select Case BOSTool.ToolName

Case "mnuEditDelete": Cancel = IsAbolish(aFClassTypeID, aFID) '删除

Case Else
End Select

'------------------------------------------------------------------------------------------------------------
' 清空对象

Set aSelect = Nothing
End Sub


Function IsAbolish(aFClassTypeID As Long, aFID As String) As Boolean

Dim aSql As String, i As Long, aBillNo As String, aRecordset As ADODB.Recordset: IsAbolish = False

'------------------------------------------------------------------------------------------------------------
'【已作废】

aSql = "select FBillNo from a_StockBill where FClassTypeID = " & aFClassTypeID & " and FCancellation = 1 and FID in ( " & aFID & " ) order by FBillNo"

Set aRecordset = m_ListInterface.K3Lib.GetData(aSql): aBillNo = ""
If aRecordset.RecordCount > 0 Then

For i = 1 To aRecordset.RecordCount
aBillNo = aBillNo & " " & aRecordset("FBillNo"): aRecordset.MoveNext
Next

IsAbolish = True: MsgBox "以下单据 已作废！请先反作废，再删除 " & vbCrLf & vbCrLf & aBillNo, vbExclamation, "一星提示"
End If

Set aRecordset = Nothing
End Function 郭少锋 创建 2023-03-30 20:42:59 K3 BOS