先看结果,原料中有很多规格设置不规范的地方,特别是有些空着的、有些不规则
基本上原则是圆料时,将宽锁定,没有规格或是型号及角铁管材类的,将高和宽都锁定,直接使用规格,就不拆分了
'''按原料规格进行长宽高的拆分
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 oldsize As String
Dim newsize1 As String, newsize2 As String
Dim i As Integer, j As Integer, k As Integer
Dim xPosition As Integer
Dim numb1 As Integer, numb2 As Integer
Dim chr As String
Dim dct2 As KFO.Dictionary
Dim XC As String '型材
If Row > 0 Then
oldsize = m_BillInterface.Data("page2")(Row)(m_BillInterface.TableInfo("map")("FBaseProperty3"))("ffld") '获取规格
End If
XC = m_BillInterface.Data("page2")(Row)(m_BillInterface.TableInfo("map")("FBaseProperty4"))("ffld") '获取材料类型
If oldsize <> "" Then
''如果换了一个规格不为空的零件,先将长宽解锁
Call LockOneCell(m_BillInterface, "FInteger4", Row, False) '直接/高
If XC <> "圆料" Then '如果型材不是圆料就将宽解锁
Call LockOneCell(m_BillInterface, "FInteger2", Row, False) '宽
End If
'先判断×的个数,如果像角钢槽钢类似40×40×4之类的,就直接用规格不进行拆分了
''如果像Q235这样10×20的,将数字小的设成厚度,大的设成高度
i = 0
k = 0
For i = 1 To Len(oldsize)
Char = Mid(oldsize, i, 1)
If Char = "×" Then
k = k + 1
End If
Next i
If k = 0 Then
' 使用Asc函数获取当前字符的ASCII码,并使用Chr函数将ASCII码转换回字符进行比较
' 检查当前字符是否是数字(ASCII码范围48到57对应于'0'到'9')
' 如果是数字,则将其添加到输出字符串
i = 0
For i = 1 To Len(oldsize)
If Asc(Mid(oldsize, i, 1)) >= 48 And Asc(Mid(oldsize, i, 1)) <= 57 Then
svalue = svalue & Mid(oldsize, i, 1)
End If
Next i
newsize1 = svalue
If CLng(newsize1) > 999 Then GoTo Err '有些是型号中有数字的
m_BillInterface.SetFieldValue "FInteger4", newsize1, Row '直径/高
ElseIf k = 1 Then '板材或管料
xPosition = InStr(1, oldsize, "×") '判断×的位置
newsize1 = Mid(oldsize, 1, xPosition - 1)
newsize2 = Mid(oldsize, xPosition + 1, Len(oldsize))
On Error GoTo Err ' 管材的规格是 直径×壁厚的,还有一些字母的,会报错
If CInt(newsize1) < CInt(newsize2) Then
m_BillInterface.SetFieldValue "FInteger4", newsize1, Row '直径/高
m_BillInterface.SetFieldValue "FInteger2", newsize2, Row '宽
Else
m_BillInterface.SetFieldValue "FInteger4", newsize2, Row '直径/高
m_BillInterface.SetFieldValue "FInteger2", newsize1, Row '宽
End If
Else '按规格,宽和高都设为0,只管长度
Err:
m_BillInterface.SetFieldValue "FInteger4", 0, Row '直径/高
m_BillInterface.SetFieldValue "FInteger2", 0, Row '宽
GoTo locker: '如果高和宽为0的话,就直接锁定
End If
Else
''如果规格为空的,就锁定高和宽
locker:
Call LockOneCell(m_BillInterface, "FInteger4", Row, True)
Call LockOneCell(m_BillInterface, "FInteger2", Row, True)
End If
End Sub
'''''''''''用于锁定单元格的代码
Public Sub LockOneCell(ByRef m_BillInterface As Object, ByVal sKey As String, ByVal nRow As Long, Optional ByVal bValue As Boolean = True)
Dim dctCtl As KFO.Dictionary
Set dctCtl = m_BillInterface.GetFieldInfoByKey(sKey, "", 0)
m_BillInterface.LockCell dctCtl, nRow, bValue
Set dctCtl = Nothing
End Sub
重新在原记录上修改,也没问题