【SAP GUI 脚本 VBA】

启用 SAP脚本

Tracker

Excel启用VBA

用法

TEXT文本

Press点击

Key选择

Selected复选框

判断字段是否存在

VerticalScrollbar 滑动滚动条

Enter

粘贴剪贴板

读取shell

读取shell[1]

实例

CO03

MM03

CS15

TEST

KS13

KSH1

KSH2

KSH3

FS00

SM30

Tcode

CKM3N

FB02

KSU1

KSU2

KSU3

KSV1、KSV2、KSV3

与其他方式对比

启用 SAP脚本

1.使用前“脚本录制和回放”的功能是要开启状态。如果没开启是要找管理员开启。

2.点击后红色按钮开启录制

3.此时可以在SAP里进行手动操作，可以记录下用户操作的脚本。

录制完之后可以点击关闭。再点击“更多”。

4.可以把这个Script1.vbs这个复制到桌面，把后缀名改成txt

如下是进入MM03查询了某个料号的脚本。

Tracker

进入SAP后，启用Tracker，点击这个图标。可以查询程式里字段的ID。

如物料的ID是

wnd[0]/usr/tabsTABSPR1/tabpSP01/ssubTABFRA1:SAPLMGMM:2004/subSUB1:SAPLMGD1:1002/ctxtRMMG1-MATNR

Excel启用VBA

勾选“开发工具”

点击“宏安全性”

点击“启用所有宏”。关闭EXCEL再打开即可。

点击“Visual Basic”

进入后点击插入

点击插入模块

在编辑界面输入SUB，命名程序后回车

可以复制录制脚本的代码进去，点击执行即可

录制的这个部分是VBS的内容，不能在EXCEL里执行，要改下。

改成的这个如果没进入SAP的话会报错。

   Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As ObjectSet SapGuiAuto = GetObject("SAPGUI")Set AppSap = SapGuiAuto.GetScriptingEngineSet Connection = AppSap.Children(0)Set session = Connection.Children(0)

用法

TEXT文本

在栏位里输入文本，例如

session.findById("wnd[0]/tbar[0]/okcd").Text = "/NCKM3N"

Press点击

点击，例如：

session.findById("wnd[0]/tbar[1]/btn[13]").press

Key选择

选择，例如：

session.findById("wnd[0]/usr/cmbMLKEY-CURTP").Key = "10"

Selected复选框

可以操作复选框，TRUE表示勾选，FALSE表示不勾选

session.findById("wnd[0]/usr/chkPA_XKONS").Selected = False

判断字段是否存在

如下是判断某个字段确实存在，删去Not表示判断某个字段确实不存在

If Not session.findById("wnd[2]/usr/txtMESSTXT1", False) Is Nothing ThenEnd If

VerticalScrollbar 滑动滚动条

16代表一次滑动16个栏位

session.findById("wnd[1]/usr/tblSAPLMGMMTC_VIEW").verticalScrollbar.Position = 16

Enter

输入Enter键

session.findById("wnd[0]").sendVKey 0

粘贴剪贴板

先声明了字典d，在Excel中取值（此处省略了这个部分），然后通过“多项选择”，除去重复值后，粘贴到剪贴板中

Dim objData As New MSForms.DataObject, d As Object
Dim objData As New MSForms.DataObjectWith session.findById("wnd[0]/usr/btn%_SO_WERKS_%_APP_%-VALU_PUSH").press '点击objData.SetText Join(d.keys, Chr(13) & Chr(10))objData.PutInClipboard '复制到剪贴板中.findById("wnd[1]/tbar[0]/btn[16]").press '删除整个选择.findById("wnd[1]/tbar[0]/btn[24]").press '自剪切板上载.findById("wnd[1]/tbar[0]/btn[8]").press '点击d.RemoveAll '删除
End With

读取shell

'读取shell时不同于text，要通过循环取值
'把取到的shell赋值给Table
'Table.RowCount表示总行数
'Table.ColumnCount表示总列数
'Table.ColumnOrder可以取列名
'Table.getcellvalue 可以取表的值
'例如此处把取到的Table传到了数组arr里，然后在读取到Excel中Dim x As Integer, y As Integer, k As Integer, arr(), Title()
ReDim arr(1 To 100000, 1 To 15)
ReDim Title(1 To 15)With sessionSet Table = .findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell")Set Columns = Table.ColumnOrder() '取列For x = 0 To Table.RowCount() - 1 'Table.RowCount表示为总行数k = k + 1For y = 0 To Table.ColumnCount() - 1arr(k, y + 1) = Table.getcellvalue(x, CStr(Columns(y))) '取值Next yNext xFor y = 0 To Table.ColumnCount() - 1Title(y + 1) = CStr(Columns(y)) 'Columns返回标题文本Next y
End With

读取shell[1]

    '读取shell[1]里隐藏的内容时需要打开节点'Table.GetAllNodeKeys 表示所有的节点，返回值是数字'Table.expandNode 打开节点'Table.GetAllNodeKeys.Count 表示总节点数'Table.getitemtext 可以获取内容Dim Table As Object, GetNodeK As Object, arr(), i As Integer, x'进入程式获取节点With session.findById("wnd[0]").maximize.findById("wnd[0]/tbar[0]/okcd").Text = "/NFS00".findById("wnd[0]").sendVKey 0 'EnterSet Table = .findById("wnd[0]/shellcont/shell/shellcont[1]/shell[1]")Set GetNodeK = Table.GetAllNodeKeys '得到所有的节点End With'打开所有节点For x = GetNodeK.Count - 1 To 0 Step -1Table.expandNode GetNodeK.Item(x)Next x'重新读取shell[1]Set Table = session.findById("wnd[0]/shellcont/shell/shellcont[1]/shell[1]")Set GetNodeK = Table.GetAllNodeKeys '得到所有的节点For x = 0 To GetNodeK.Count - 1i = i + 1ReDim Preserve arr(1 To i)arr(i) = GetNodeK.Item(x) '节点arr(i) = Table.getitemtext(arr(i), "&Hierarchy") '获得内容Next x

实例

CO03

CO03中批量查询研发工单的信息

Sub CO03_显示_结算规则()Dim iMg As VbMsgBoxStyleiMg = MsgBox("是否显示CO03？" & Chr(10) & " " & Chr(10), vbYesNo, "CO03")If iMg = 7 Then Exit SubDim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As ObjectSet SapGuiAuto = GetObject("SAPGUI")Set AppSap = SapGuiAuto.GetScriptingEngineSet Connection = AppSap.Children(0)Set session = Connection.Children(0)Dim x As Integer, y As Integer, sr As String, rg As Range, arr1(), i As Integer, bl As BooleanDim Table As Object, Columns As ObjectReDim arr2(1 To 1000, 1 To 10)sr = "CO03"Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")If rg Is Nothing ThenMsgBox "错误！表【" & sr & "】中无数据！"Exit SubEnd Ifarr1 = rg.CurrentRegion.ValueWith sessionFor x = 2 To UBound(arr1)If arr1(x, 1) = "" Then Exit For.findById("wnd[0]").maximize.findById("wnd[0]/tbar[0]/okcd").Text = "/NCO03".findById("wnd[0]").sendVKey 0 'Enter.findById("wnd[0]/usr/ctxtCAUFVD-AUFNR").Text = arr1(x, 1) '工单.findById("wnd[0]").sendVKey 0 'arr2(x - 1, 1) = "'" & .findById("wnd[0]/usr/ctxtCAUFVD-WERKS").Text '工厂.findById("wnd[0]/usr/tabsTABSTRIP_0115/tabpVERW").Select '管理arr2(x - 1, 2) = .findById("wnd[0]/usr/tabsTABSTRIP_0115/tabpVERW/ssubSUBSCR_0115:SAPLCOKO1:0170/txtCAUFVD-ERNAM").Text '创建arr2(x - 1, 3) = .findById("wnd[0]/usr/tabsTABSTRIP_0115/tabpVERW/ssubSUBSCR_0115:SAPLCOKO1:0170/txtCAUFVD-AENAM").Text '更改.findById("wnd[0]/mbar/menu[4]/menu[3]").Select '结算规则arr2(x - 1, 4) = .findById("wnd[0]/usr/tblSAPLKOBSTC_RULES/ctxtCOBRB-KONTY[0,1]").Text 'CTR.findById("wnd[0]").sendVKey 2 '进入结算规则里arr2(x - 1, 5) = .findById("wnd[0]/usr/subBLOCK1:SAPLKOBS:0200/txtCOBR_INFO-OBJ_TEXT").Text ' 工单说明arr2(x - 1, 6) = .findById("wnd[0]/usr/subBLOCK2:SAPLKACB:1014/ctxtCOBL-KOSTL").Text '成本中心arr2(x - 1, 7) = .findById("wnd[0]/usr/subBLOCK2:SAPLKACB:1014/ctxtCOBL-PS_POSID").Text 'WBS元素arr2(x - 1, 8) = .findById("wnd[0]/usr/subBLOCK2:SAPLKACB:1014/ctxtCOBL-SAKNR").Text '总账科目arr2(x - 1, 9) = .findById("wnd[0]/usr/subBLOCK2:SAPLKACB:1014/ctxtCOBL-PRCTR").Text '利润中心arr2(x - 1, 10) = .findById("wnd[0]/usr/txtCOBRB-PROZS").Text '百分比Next xEnd WithWith ThisWorkbook.Sheets("CO03").AutoFilterMode = FalseWith .Cells(1, 2).Resize(1, UBound(arr2, 2)).EntireColumn.ClearContents.Resize(1, UBound(arr2, 2)) = Split("工厂;创建人;更改人;CTR;工单说明;成本中心;WBS元素;总账科目;利润中心;百分比", ";").Cells(2, 1).Resize(UBound(arr1), UBound(arr2, 2)) = arr2End WithEnd With
End Sub

MM03

MM03查询标估价等

Sub MM03_显示物料()Dim iMg As VbMsgBoxStyleiMg = MsgBox("是否显示物料？" & Chr(10) & " " & Chr(10), vbYesNo, "MM03")If iMg = 7 Then Exit SubDim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As ObjectSet SapGuiAuto = GetObject("SAPGUI")Set AppSap = SapGuiAuto.GetScriptingEngineSet Connection = AppSap.Children(0)Set session = Connection.Children(0)Dim x As Integer, y As Integer, sr As String, rg As Range, arr1(), k As Integer, i As Integer, j As Integer, bl As BooleanDim Table As Object, Columns As ObjectReDim arr2(1 To 10000, 1 To 20)sr = "MM03"Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")If rg Is Nothing ThenMsgBox "错误！表【" & sr & "】中无数据！"Exit SubEnd Ifarr1 = rg.CurrentRegion.Valuebl = FalseWith sessionFor x = 2 To UBound(arr1)If arr1(x, 1) = "" Then Exit For.findById("wnd[0]").maximize.findById("wnd[0]/tbar[0]/okcd").Text = "/NMM03".findById("wnd[0]").sendVKey 0 'Enter.findById("wnd[0]/usr/ctxtRMMG1-MATNR").Text = arr1(x, 2) '查询物料.findById("wnd[0]").sendVKey 0i = 0j = 0Doi = i + 1sr = "wnd[1]/usr/tblSAPLMGMMTC_VIEW/txtMSICHTAUSW-DYTXT[0," & i & "]"If .findById(sr, False) Is Nothing Thenbl = TrueExit DoElseIf .findById(sr).Text = "会计 1" Then.findById("wnd[1]/usr/tblSAPLMGMMTC_VIEW").getAbsoluteRow(j * 16 + i).Selected = True.findById("wnd[1]/tbar[0]/btn[0]").pressExit DoEnd IfEnd IfIf i Mod 16 = 0 Then '选择视图最大有16个栏位， 超过要下滑滚动条.findById("wnd[1]/usr/tblSAPLMGMMTC_VIEW").verticalScrollbar.Position = 16i = 0j = j + 1End IfLoopIf .findById("wnd[0]/sbar/pane[0]").Text <> "" Then '物料查不到下面会有一个警告冒出来bl = TrueElsesr = "wnd[2]/tbar[0]/btn[0]"If Not session.findById(sr, False) Is Nothing Then '测试区没有这个错误提示，正式区有.findById(sr).press '输入工厂前有个错误提示要确定End If.findById("wnd[1]/usr/ctxtRMMG1-WERKS").Text = arr1(x, 1).findById("wnd[1]/tbar[0]/btn[0]").pressIf Not .findById("wnd[2]/usr/txtMESSTXT1", False) Is Nothing Then '查不到某个工厂的物料会有个警告bl = TrueElsearr2(x - 1, 4) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP25/ssubTABFRA1:SAPLMGMM:2000/subSUB2:SAPLMGD1:2800/subSUB1:SAPLCKMMAT:0010/tabsTABS/tabpPPLF").Text '会计期间arr2(x - 1, 5) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP25/ssubTABFRA1:SAPLMGMM:2000/subSUB2:SAPLMGD1:2800/subSUB1:SAPLCKMMAT:0010/tabsTABS/tabpPPLF/ssubSUBML:SAPLCKMMAT:0100/subSUBCURR:SAPLCKMMAT:0200/txtCKMMAT_DISPLAY-STPRS_1").Text '公司代码货币 标准价格arr2(x - 1, 6) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP25/ssubTABFRA1:SAPLMGMM:2000/subSUB2:SAPLMGD1:2800/subSUB1:SAPLCKMMAT:0010/tabsTABS/tabpPPLF/ssubSUBML:SAPLCKMMAT:0100/subSUBCURR:SAPLCKMMAT:0200/txtCKMMAT_DISPLAY-PEINH_1").Text '公司代码货币 价格单位arr2(x - 1, 7) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP25/ssubTABFRA1:SAPLMGMM:2000/subSUB2:SAPLMGD1:2800/subSUB1:SAPLCKMMAT:0010/tabsTABS/tabpPPLF/ssubSUBML:SAPLCKMMAT:0100/subSUBCURR:SAPLCKMMAT:0200/txtCKMMAT_DISPLAY-STPRS_2").Text '集团公司记帐货币，利润中心评估arr2(x - 1, 8) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP25/ssubTABFRA1:SAPLMGMM:2000/subSUB2:SAPLMGD1:2800/subSUB1:SAPLCKMMAT:0010/tabsTABS/tabpPPLF/ssubSUBML:SAPLCKMMAT:0100/subSUBCURR:SAPLCKMMAT:0200/txtCKMMAT_DISPLAY-PEINH_2").Text '集团公司记帐货币，利润中心评估 价格单位.findById("wnd[0]/usr/tabsTABSPR1/tabpSP28").Select '成本核算2arr2(x - 1, 1) = "'" & .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB1:SAPLMGD1:1009/ctxtRMMG1-WERKS").Text '工厂arr2(x - 1, 2) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB1:SAPLMGD1:1009/ctxtRMMG1-MATNR").Text '物料arr2(x - 1, 3) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB1:SAPLMGD1:1009/txtMAKT-MAKTX").Text '描述arr2(x - 1, 9) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB2:SAPLMGD1:2953/txtMBEW-PDATL").Text '会计年度arr2(x - 1, 10) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB2:SAPLMGD1:2953/txtMBEW-PPRDL").Text '期间arr2(x - 1, 11) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB4:SAPLMGD1:2902/ctxtMBEW-BKLAS").Text '评估类arr2(x - 1, 12) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB4:SAPLMGD1:2902/ctxtMBEW-VPRSV").Text '价格控制arr2(x - 1, 13) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB4:SAPLMGD1:2902/txtMBEW-PEINH").Text '价格单位arr2(x - 1, 14) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB2:SAPLMGD1:2953/txtMBEW-LPLPR").Text '计划价格arr2(x - 1, 15) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB2:SAPLMGD1:2953/txtMBEW-STPRS").Text '标准价格arr2(x - 1, 16) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB3:SAPLMGD1:2952/txtMBEW-ZPLP1").Text '计划价格1arr2(x - 1, 17) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB3:SAPLMGD1:2952/ctxtMBEW-ZPLD1").Text '计划价格日期1arr2(x - 1, 18) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB2:SAPLMGD1:2953/txtMBEW-PPRDZ").Text '将来期间arr2(x - 1, 19) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB2:SAPLMGD1:2953/txtMBEW-PDATZ").Text '将来年份arr2(x - 1, 20) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB2:SAPLMGD1:2953/txtMBEW-ZPLPR").Text '将来价格End IfEnd IfNext xEnd WithWith ThisWorkbook.Sheets("MM03").AutoFilterMode = FalseWith .Cells(1, 3).Resize(1, UBound(arr2, 2)).EntireColumn.ClearContents.Resize(1, UBound(arr2, 2)) = Split("工厂;物料;描述;会计期间;公司标准价;公司价格单位;利润中心标准价;利润中心价格单位;会计年度;期间;评估类;价格控制;价格单位;计划价格;标准价格;计划价格1;计划价格日期1;将来期间;将来年份;将来价格", ";").Cells(2, 1).Resize(UBound(arr1), UBound(arr2, 2)) = arr2End WithEnd WithIf bl ThenMsgBox "注意！有物料没查到！"ElseMsgBox "成功"End If
End Sub

CS15

CS15查询多个料号的BOM

Sub CS15_单层反查清单_多层()Dim iMg As VbMsgBoxStyleiMg = MsgBox("是否显示 CS15？" & Chr(10) & " " & Chr(10), vbYesNo, "CS15 - 单层反查清单")If iMg = 7 Then Exit SubDim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As ObjectSet SapGuiAuto = GetObject("SAPGUI")Set AppSap = SapGuiAuto.GetScriptingEngineSet Connection = AppSap.Children(0)Set session = Connection.Children(0)Dim x As Integer, y As Integer, z As Integer, sr As String, rg As Range, arr1(), k As Integer, brr(), bl As BooleanDim Table As Object, Columns As ObjectReDim arr2(1 To 100000, 1 To 15) '此处要提前知道列数，并且加了一列 'Table.ColumnCount()ReDim brr(1 To 15)sr = "CS15"Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")If rg Is Nothing ThenMsgBox "错误！表【" & sr & "】中无数据！"Exit SubEnd Ifarr1 = rg.CurrentRegion.Valuebrr(1) = "物料"With sessionFor z = 2 To UBound(arr1)If arr1(z, 1) = "" Then Exit For.findById("wnd[0]").maximize.findById("wnd[0]/tbar[0]/okcd").Text = "/NCS15".findById("wnd[0]").sendVKey 0 'Enter.findById("wnd[0]/usr/ctxtRC29L-DATUV").Text = TheTime(0, "yyyy.mm.dd").findById("wnd[0]/usr/ctxtRC29L-MATNR").Text = arr1(z, 2) '物料.findById("wnd[0]/usr/chkRC29L-DIRKT").Selected = True.findById("wnd[0]/tbar[1]/btn[5]").press.findById("wnd[0]/usr/ctxtRC29L-WERKS").Text = arr1(z, 1) '工厂.findById("wnd[0]/usr/chkRC29L-MEHRS").Selected = True '多层.findById("wnd[0]/tbar[1]/btn[8]").pressIf .findById("wnd[0]/sbar/pane[0]").Text <> "" Thenbl = Truek = k + 1arr2(k, 1) = arr1(z, 2)arr2(k, 4) = arr1(z, 1)arr2(k, 5) = .findById("wnd[0]/sbar/pane[0]").TextElseSet Table = .findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell")Set Columns = Table.ColumnOrder()For x = 0 To Table.RowCount() - 1k = k + 1arr2(k, 1) = arr1(z, 2)For y = 0 To Table.ColumnCount() - 1arr2(k, y + 2) = Table.getcellvalue(x, CStr(Columns(y)))Next yIf x Mod 39 = 0 Then 'bom 测试是每39行后要刷一次屏，否则导出的数据是空白Table.SetCurrentCell x, CStr(Columns(0))Table.firstVisibleRow = xEnd IfNext xFor y = 0 To Table.ColumnCount() - 1brr(y + 2) = CStr(Columns(y)) '目前关闭Next yEnd IfNext zEnd WithFor x = 1 To karr2(x, 4) = "'" & arr2(x, 4)Next xWith ThisWorkbook.Sheets("CS15").AutoFilterMode = FalseWith .Cells(1, 3).Resize(1, UBound(arr2, 2)).EntireColumn.ClearContents.Resize(1, UBound(arr2, 2)) = brr '目前没用.Resize(1, UBound(arr2, 2)) = Split("物料;级别;物料清单用途;工厂;对象;对象标识;备选物料清单;项目编号;超出需求数量;需求数量;组件计量单位;ResQ excess;重计划数量;基本计量单位;对象描述", ";")If k > 0 Then .Cells(2, 1).Resize(k, UBound(arr2, 2)) = arr2End WithEnd WithIf bl ThenMsgBox "注意！有部分没有查到！"ElseMsgBox "成功"End If
End Sub

TEST

测试运行，读取Shell

Sub test()Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As ObjectSet SapGuiAuto = GetObject("SAPGUI")Set AppSap = SapGuiAuto.GetScriptingEngineSet Connection = AppSap.Children(0)Set session = Connection.Children(0)Dim Table As Object, Columns As ObjectDim x As Integer, y As Integer, k As Integer, arr(), Title()ReDim arr(1 To 100000, 1 To 15)ReDim Title(1 To 15)With sessionSet Table = .findById("wnd[0]/usr/cntlFDBL_BALANCE_CONTAINER/shellcont/shell")  '把表shell赋值给TableSet Columns = Table.ColumnOrder() '取列For x = 0 To Table.RowCount() - 1  'Table.RowCount表示为总行数k = k + 1For y = 0 To Table.ColumnCount() - 1 'Table.ColumnCount表示总列数Table.ColumnCountarr(k, y + 1) = Table.getcellvalue(x, CStr(Columns(y))) '取值Next yNext xFor y = 0 To Table.ColumnCount() - 1Title(y + 1) = CStr(Columns(y)) 'Columns返回标题文本Next yEnd WithWith ThisWorkbook.Sheets("test").AutoFilterMode = False.Cells.ClearContents.Cells(1, 1).Resize(1, UBound(arr, 2)) = TitleIf k > 0 Then .Cells(2, 1).Resize(k, UBound(arr, 2)) = arrEnd With
End Sub

KS13

KS13用Excel导出的方式批量读取成本中心


Sub KS13_显示成本中心()Dim iMg As VbMsgBoxStyleiMg = MsgBox("是否显示成本中心？" & Chr(10) & " " & Chr(10), vbYesNo, "KS13")If iMg = 7 Then Exit SubDim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As ObjectSet SapGuiAuto = GetObject("SAPGUI")Set AppSap = SapGuiAuto.GetScriptingEngineSet Connection = AppSap.Children(0)Set session = Connection.Children(0)Dim x As Long, y As Integer, z As Integer, sr As String, rg As Range, bl As Boolean, wb As Workbook, j As IntegerDim arr1(), arr2(), arr3(), k As LongReDim arr3(1 To 100000, 1 To 23)sr = "KS13"Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")If rg Is Nothing ThenMsgBox "错误！表【" & sr & "】中无数据！"Exit SubEnd Ifarr1 = rg.CurrentRegion.ValueCall KillSapPathWith sessionFor z = 2 To UBound(arr1)If arr1(z, 1) = "" Then Exit For.findById("wnd[0]").maximize.findById("wnd[0]/tbar[0]/okcd").Text = "/NKS13".findById("wnd[0]").sendVKey 0 'Enter.findById("wnd[0]/usr/subKOSTL_SELECTION:SAPLKMS1:0100/radKMAS_D-KZKOSTL").Select.findById("wnd[0]/usr/subKOSTL_SELECTION:SAPLKMS1:0100/ctxtKMAS_D-KOSTL").Text = "" '成本中心.findById("wnd[0]/usr/subKOSTL_SELECTION:SAPLKMS1:0100/radKMAS_D-KZVARIANT").Select.findById("wnd[0]/usr/subKOSTL_SELECTION:SAPLKMS1:0100/ctxtKMAS_D-VARIANT_KS").Text = "" '选择变式.findById("wnd[0]/usr/ctxtCSKSZ-DATAB_ANFO").Text = TheTime(0, "yyyy.mm.01").findById("wnd[0]/usr/subKOSTL_SELECTION:SAPLKMS1:0100/radKMAS_D-KZKOSTLSET").Select.findById("wnd[0]/usr/subKOSTL_SELECTION:SAPLKMS1:0100/ctxtKMAS_D-KOSTL_SET").Text = arr1(z, 1) '成本中心组.findById("wnd[0]/tbar[1]/btn[8]").press '执行bl = Truesr = "wnd[0]/sbar/pane[0]"If .findById(sr, False) Is Nothing ThenIf Right(.findById(sr), 3) <> "不存在" Thenbl = FalseEnd IfEnd IfIf bl ThenIf Not .findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell", False) Is Nothing Then.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").contextMenu.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").selectContextMenuItem "&XXL".findById("wnd[1]/tbar[0]/btn[0]").press.findById("wnd[1]/usr/ctxtDY_PATH").Text = SapPath()j = j + 1 '每次命名的文件不一致.findById("wnd[1]/usr/ctxtDY_FILENAME").Text = j & ".XLSX".findById("wnd[1]/tbar[0]/btn[0]").pressSet wb = Workbooks.Open(SapPath() & "/" & j & ".XLSX") '对文件取值arr2 = wb.Sheets(1).Range("A1").CurrentRegion.Valuewb.CloseSet wb = NothingFor x = 2 To UBound(arr2)k = k + 1arr3(k, 1) = arr1(z, 1)For y = 1 To UBound(arr2, 2)arr3(k, y + 1) = arr2(x, y)Next yNext xEnd IfEnd IfNext zEnd WithWith ThisWorkbook.Sheets("KS13").AutoFilterMode = FalseWith .Cells(1, 2).Resize(1, UBound(arr3, 2)).EntireColumn.ClearContents.Resize(1, UBound(arr3, 2)) = Split("成本中心组;成本中心;部门编码;名称;描述;负责人;部门;利润中心;公司代码;数据线;打印机所在地;货币;CostCtrCat;功能范围;有效期自;有效期至;计划: 次成本(锁标识);计划: 收入(锁标识);计划: 主成本(锁标识);实际: 收入 (锁标识);实际: 主成本(锁标识);实际:次收入 (锁标识);成本核算表", ";")If k > 0 Then .Cells(2, 1).Resize(k, UBound(arr3, 2)) = arr3End WithEnd WithMsgBox "完成！"
End Sub

KSH1

KSH1建立成本中心组

Sub KSH1_创建成本中心组()Dim iMg As VbMsgBoxStyleiMg = MsgBox("是否创建成本中心组？" & Chr(10) & " " & Chr(10) & "创建之前要自行检查下是否确实需要创建！", vbYesNo, "KSH1")If iMg = 7 Then Exit SubDim x As Integer, y As Integer, rg As Range, sr As String, sg As String, v, u, i As Integer, j As Integer, k As Integersr = "KSH1"Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")If rg Is Nothing ThenMsgBox "错误！表【" & sr & "】中无数据！"Exit SubEnd IfDim arr()arr = rg.CurrentRegion.ValueDim dZ As ObjectSet dZ = CreateObject("scripting.dictionary")For x = 1 To UBound(arr, 2)dZ(arr(1, x)) = xNext xDim a As Byte, b As Byte, c As Byte, d As Bytea = dZ("成本中心组")b = dZ("成本中心组名称")c = dZ("成本中心")d = dZ("成本中心名称")Dim dic1 As Object, dic2 As ObjectSet dic1 = CreateObject("scripting.dictionary")Set dic2 = CreateObject("scripting.dictionary")For x = 2 To UBound(arr)sr = arr(x, a)sg = arr(x, c)If Not dic1.exists(sr) ThenSet dic1(sr) = CreateObject("scripting.dictionary")End Ifdic1(sr)(sg) = ""Next xFor x = 2 To UBound(arr)sr = arr(x, a)sg = arr(x, b)dic2(sr) = sgNext xDim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object, PositionSet SapGuiAuto = GetObject("SAPGUI")Set AppSap = SapGuiAuto.GetScriptingEngineSet Connection = AppSap.Children(0)Set session = Connection.Children(0)With sessionFor Each v In dic1.keys.findById("wnd[0]").maximize.findById("wnd[0]/tbar[0]/okcd").Text = "/NKSH1".findById("wnd[0]").sendVKey 0 'EnterIf Not .findById("wnd[1]/usr/sub:SAPLSPO4:0300/ctxtSVALD-VALUE[0,21]", False) Is Nothing Then '检测是否需要输入控制范围.findById("wnd[1]/usr/sub:SAPLSPO4:0300/ctxtSVALD-VALUE[0,21]").Text = 2688.findById("wnd[0]").sendVKey 0End If.findById("wnd[0]/usr/ctxtGRPDYNP-NAME_COALL").Text = v.findById("wnd[0]").sendVKey 0If Not .findById("wnd[1]/usr/btnBUTTON_2", False) Is Nothing Then '检测是否被创建.findById("wnd[1]/usr/btnBUTTON_2").pressMsgBox "失败！【" & v & "】已经被创建！"Exit SubEnd If.findById("wnd[0]/usr/txt[16,0]").Text = dic2(CStr(v))i = 1 '记录屏幕上的输入框行数，跨页要重置j = 0 '计算点击“插入成本中心”的次数k = 0 '计算“竖向滚动条”下拉的频次Doj = j + 1.findById("wnd[0]/tbar[1]/btn[16]").pressLoop Until j = dic1(CStr(v)).Count \ 5 + 1 '点击“插入成本中心”一次可以填五个成本中心For Each u In dic1(CStr(v)).keysi = i + 1.findById("wnd[0]/usr/txt[4," & i & "]").Text = uIf i Mod 29 = 0 Then '测试DELL电脑最大显示的成本中心个数，到46时 i 会报错，要填45；测试华硕电脑是要写29k = k + 1.findById("wnd[0]/usr").verticalScrollbar.Position = i * ki = 0End IfNext u.findById("wnd[0]/tbar[0]/btn[11]").press '保存（慎用）Next vEnd WithMsgBox "成功！"
End Sub

KSH2

KSH2修改成本中心组

Sub KSH2_标题()Dim arr() As Stringarr = Split("成本中心组;成本中心组名称;成本中心;成本中心名称", ";")With ThisWorkbook.Sheets("KSH2").AutoFilterMode = False.Cells(1, 1).Resize(1, UBound(arr) + 1) = arrEnd With
End SubSub KSH2_修改成本中心组_重置() '会修改成本中心组名称Dim iMg As VbMsgBoxStyleiMg = MsgBox("是否修改成本中心组？" & Chr(10) & " " & Chr(10) & "修改之前要检查成本中心组是否已经创建，否则会出现修改一半进行不下去的情况！", vbYesNo, "KSH2")If iMg = 7 Then Exit SubDim x As Integer, y As Integer, rg As Range, sr As String, sg As String, v, u, i As Integer, j As Integer, k As Integersr = "KSH2"Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")If rg Is Nothing ThenMsgBox "错误！表【" & sr & "】中无数据！"Exit SubEnd IfDim arr()arr = rg.CurrentRegion.ValueDim dZ As ObjectSet dZ = CreateObject("scripting.dictionary")For x = 1 To UBound(arr, 2)dZ(arr(1, x)) = xNext xDim a As Byte, b As Byte, c As Byte, d As Bytea = dZ("成本中心组")b = dZ("成本中心组名称")c = dZ("成本中心")d = dZ("成本中心名称")Dim dic1 As Object, dic2 As ObjectSet dic1 = CreateObject("scripting.dictionary")Set dic2 = CreateObject("scripting.dictionary")For x = 2 To UBound(arr)sr = arr(x, a)sg = arr(x, c)If Not dic1.exists(sr) ThenSet dic1(sr) = CreateObject("scripting.dictionary")End Ifdic1(sr)(sg) = ""Next xFor x = 2 To UBound(arr)sr = arr(x, a)sg = arr(x, b)dic2(sr) = sgNext xDim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object, PositionSet SapGuiAuto = GetObject("SAPGUI")Set AppSap = SapGuiAuto.GetScriptingEngineSet Connection = AppSap.Children(0)Set session = Connection.Children(0)With sessionFor Each v In dic1.keys.findById("wnd[0]").maximize.findById("wnd[0]/tbar[0]/okcd").Text = "/NKSH2".findById("wnd[0]").sendVKey 0 'EnterIf Not .findById("wnd[1]/usr/sub:SAPLSPO4:0300/ctxtSVALD-VALUE[0,21]", False) Is Nothing Then '检测是否需要输入控制范围.findById("wnd[1]/usr/sub:SAPLSPO4:0300/ctxtSVALD-VALUE[0,21]").Text = 2688.findById("wnd[0]").sendVKey 0End If.findById("wnd[0]/usr/ctxtGRPDYNP-NAME_COALL").Text = v.findById("wnd[0]").sendVKey 0If Not .findById("wnd[1]/usr/btnBUTTON_2", False) Is Nothing Then '检测是否有成本中心组.findById("wnd[1]/usr/btnBUTTON_2").pressMsgBox "失败！【" & v & "】还没创建！"Exit SubEnd If.findById("wnd[0]/usr/txt[16,0]").Text = dic2(CStr(v))Do '删除组下面所有的成本中心If .findById("wnd[0]/usr/lbl[4,2]", False) Is Nothing Then Exit Do.findById("wnd[0]/usr/lbl[4,2]").SetFocus.findById("wnd[0]/tbar[1]/btn[9]").press.findById("wnd[0]/tbar[1]/btn[5]").pressLoopi = 1 '记录屏幕上的输入框行数，跨页要重置j = 0 '计算点击“插入成本中心”的次数k = 0 '计算“竖向滚动条”下拉的频次Doj = j + 1.findById("wnd[0]/tbar[1]/btn[16]").pressLoop Until j = dic1(CStr(v)).Count \ 5 + 1 '点击“插入成本中心”一次可以填五个成本中心For Each u In dic1(CStr(v)).keysi = i + 1.findById("wnd[0]/usr/txt[4," & i & "]").Text = uIf i Mod 29 = 0 Then '测试DELL电脑最大显示的成本中心个数，到46时 i 会报错，要填45；测试华硕电脑是要写29k = k + 1.findById("wnd[0]/usr").verticalScrollbar.Position = i * ki = 0End IfNext u.findById("wnd[0]/tbar[0]/btn[11]").press '保存（慎用）Next vEnd WithMsgBox "成功！"
End SubSub KSH2_修改成本中心组_新增()  '不会改成本中心组名称Dim iMg As VbMsgBoxStyleiMg = MsgBox("是否修改成本中心组？" & Chr(10) & " " & Chr(10) & "修改之前要检查成本中心组是否已经创建，否则会出现修改一半进行不下去的情况！", vbYesNo, "KSH2")If iMg = 7 Then Exit SubDim x As Integer, y As Integer, rg As Range, sr As String, sg As String, v, u, i As Integer, j As Integer, k As Integersr = "KSH2"Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")If rg Is Nothing ThenMsgBox "错误！表【" & sr & "】中无数据！"Exit SubEnd IfDim arr()arr = rg.CurrentRegion.ValueDim dZ As ObjectSet dZ = CreateObject("scripting.dictionary")For x = 1 To UBound(arr, 2)dZ(arr(1, x)) = xNext xDim a As Byte, b As Byte, c As Byte, d As Bytea = dZ("成本中心组")b = dZ("成本中心组名称")c = dZ("成本中心")d = dZ("成本中心名称")Dim dic1 As ObjectSet dic1 = CreateObject("scripting.dictionary")For x = 2 To UBound(arr)sr = arr(x, a)sg = arr(x, c)If Not dic1.exists(sr) ThenSet dic1(sr) = CreateObject("scripting.dictionary")End Ifdic1(sr)(sg) = ""Next xDim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object, PositionSet SapGuiAuto = GetObject("SAPGUI")Set AppSap = SapGuiAuto.GetScriptingEngineSet Connection = AppSap.Children(0)Set session = Connection.Children(0)With sessionFor Each v In dic1.keys.findById("wnd[0]").maximize.findById("wnd[0]/tbar[0]/okcd").Text = "/NKSH2".findById("wnd[0]").sendVKey 0 'EnterIf Not .findById("wnd[1]/usr/sub:SAPLSPO4:0300/ctxtSVALD-VALUE[0,21]", False) Is Nothing Then '检测是否需要输入控制范围.findById("wnd[1]/usr/sub:SAPLSPO4:0300/ctxtSVALD-VALUE[0,21]").Text = 2688.findById("wnd[0]").sendVKey 0End If.findById("wnd[0]/usr/ctxtGRPDYNP-NAME_COALL").Text = v.findById("wnd[0]").sendVKey 0If Not .findById("wnd[1]/usr/btnBUTTON_2", False) Is Nothing Then '检测是否有成本中心组.findById("wnd[1]/usr/btnBUTTON_2").pressMsgBox "失败！【" & v & "】还没创建！"Exit SubEnd Ifi = 1 '记录屏幕上的输入框行数，跨页要重置j = 0 '计算点击“插入成本中心”的次数k = 0 '计算“竖向滚动条”下拉的频次Doj = j + 1.findById("wnd[0]/tbar[1]/btn[16]").pressLoop Until j = dic1(CStr(v)).Count \ 5 + 1 '点击“插入成本中心”一次可以填五个成本中心For Each u In dic1(CStr(v)).keysi = i + 1.findById("wnd[0]/usr/txt[4," & i & "]").Text = uIf i Mod 29 = 0 Then '测试DELL电脑最大显示的成本中心个数，到46时 i 会报错，要填45；测试华硕电脑是要写29k = k + 1.findById("wnd[0]/usr").verticalScrollbar.Position = i * ki = 0End IfNext u.findById("wnd[0]/tbar[0]/btn[11]").press '保存（慎用）Next vEnd WithMsgBox "成功！"
End SubSub KSH2_修改成本中心组_删除() '不会改成本中心组名称Dim iMg As VbMsgBoxStyleiMg = MsgBox("是否修改成本中心组？" & Chr(10) & " " & Chr(10) & "修改之前要检查成本中心组是否已经创建，否则会出现修改一半进行不下去的情况！", vbYesNo, "KSH2")If iMg = 7 Then Exit SubDim x As Integer, y As Integer, rg As Range, sr As String, sg As String, v, u, i As Integer, j As Integer, k As Integersr = "KSH2"Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")If rg Is Nothing ThenMsgBox "错误！表【" & sr & "】中无数据！"Exit SubEnd IfDim arr()arr = rg.CurrentRegion.ValueDim dZ As ObjectSet dZ = CreateObject("scripting.dictionary")For x = 1 To UBound(arr, 2)dZ(arr(1, x)) = xNext xDim a As Byte, b As Byte, c As Byte, d As Bytea = dZ("成本中心组")b = dZ("成本中心组名称")c = dZ("成本中心")d = dZ("成本中心名称")Dim dic1 As ObjectSet dic1 = CreateObject("scripting.dictionary")For x = 2 To UBound(arr)sr = arr(x, a)sg = arr(x, c)If Not dic1.exists(sr) ThenSet dic1(sr) = CreateObject("scripting.dictionary")End Ifdic1(sr)(sg) = ""Next xDim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object, PositionSet SapGuiAuto = GetObject("SAPGUI")Set AppSap = SapGuiAuto.GetScriptingEngineSet Connection = AppSap.Children(0)Set session = Connection.Children(0)With sessionFor Each v In dic1.keys.findById("wnd[0]").maximize.findById("wnd[0]/tbar[0]/okcd").Text = "/NKSH2".findById("wnd[0]").sendVKey 0 'EnterIf Not .findById("wnd[1]/usr/sub:SAPLSPO4:0300/ctxtSVALD-VALUE[0,21]", False) Is Nothing Then '检测是否需要输入控制范围.findById("wnd[1]/usr/sub:SAPLSPO4:0300/ctxtSVALD-VALUE[0,21]").Text = 2688.findById("wnd[0]").sendVKey 0End If.findById("wnd[0]/usr/ctxtGRPDYNP-NAME_COALL").Text = v.findById("wnd[0]").sendVKey 0If Not .findById("wnd[1]/usr/btnBUTTON_2", False) Is Nothing Then '检测是否有成本中心组.findById("wnd[1]/usr/btnBUTTON_2").pressMsgBox "失败！【" & v & "】还没创建！"Exit SubEnd Ifi = 1 '记录屏幕上的输入框行数，跨页要重置j = 0 '计算点击“插入成本中心”的次数Doi = i + 1If .findById("wnd[0]/usr/lbl[4," & i & "]", False) Is Nothing Then Exit Do '没有查到的就退出If .findById("wnd[0]/usr/lbl[15," & i & "]", False) Is Nothing Then Exit Do '没有查到的就退出sr = .findById("wnd[0]/usr/lbl[4," & i & "]").TextIf dic1(CStr(v)).exists(sr) Then.findById("wnd[0]/usr/lbl[4," & i & "]").SetFocus.findById("wnd[0]/tbar[1]/btn[9]").press.findById("wnd[0]/tbar[1]/btn[5]").pressi = i - 1End IfIf i Mod 29 = 0 Then '测试DELL电脑最大显示的成本中心个数，到46时 i 会报错，要填45；测试华硕电脑是要写29j = j + 1.findById("wnd[0]/usr").verticalScrollbar.Position = i * ji = 0End IfLoop.findById("wnd[0]/tbar[0]/btn[11]").press '保存（慎用）Next vEnd WithMsgBox "成功！"
End Sub

KSH3

KSH3显示成本中心组

Sub KSH3_显示成本中心组()Dim iMg As VbMsgBoxStyleiMg = MsgBox("是否显示成本中心组？" & Chr(10) & " " & Chr(10), vbYesNo, "KSH3")If iMg = 7 Then Exit SubDim x As Integer, sr As String, rg As Range, arr1(), arr2(), brr(), k As Integer, i As Integer, j As Integer, bl As BooleanReDim arr2(1 To 100000, 1 To 5)ReDim brr(1 To 2)sr = "KSH3"Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")If rg Is Nothing ThenMsgBox "错误！表【" & sr & "】中无数据！"Exit SubEnd Ifarr1 = rg.CurrentRegion.ValueDim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object, PositionSet SapGuiAuto = GetObject("SAPGUI")Set AppSap = SapGuiAuto.GetScriptingEngineSet Connection = AppSap.Children(0)Set session = Connection.Children(0)bl = FalseWith sessionFor x = 2 To UBound(arr1)If arr1(x, 1) <> "" Then.findById("wnd[0]").maximize.findById("wnd[0]/tbar[0]/okcd").Text = "/NKSH3" '显示成本中心组.findById("wnd[0]").sendVKey 0 'EnterIf Not .findById("wnd[1]/usr/sub:SAPLSPO4:0300/ctxtSVALD-VALUE[0,21]", False) Is Nothing Then '检测是否需要输入控制范围.findById("wnd[1]/usr/sub:SAPLSPO4:0300/ctxtSVALD-VALUE[0,21]").Text = 2688.findById("wnd[0]").sendVKey 0End If.findById("wnd[0]/usr/ctxtGRPDYNP-NAME_COALL").Text = arr1(x, 1) '查询成本中心组.findById("wnd[0]").sendVKey 0 'EnterIf Not .findById("wnd[1]/usr/btnBUTTON_2", False) Is Nothing Then '检测是否有成本中心组.findById("wnd[1]/usr/btnBUTTON_2").pressbl = TrueElsebrr(1) = .findById("wnd[0]/usr/lbl[0,0]").Text   '成本中心组名称brr(2) = .findById("wnd[0]/usr/lbl[16,0]").Text '成本中心组描述i = 1 '记录屏幕上的输入框行数，跨页要重置j = 0 '计算点击“插入成本中心”的次数Doi = i + 1If .findById("wnd[0]/usr/lbl[4," & i & "]", False) Is Nothing Then Exit Do '没有查到的就退出If .findById("wnd[0]/usr/lbl[15," & i & "]", False) Is Nothing Then Exit Do '没有查到的就退出k = k + 1arr2(k, 1) = brr(1)arr2(k, 2) = brr(2)arr2(k, 3) = .findById("wnd[0]/usr/lbl[4," & i & "]").Textarr2(k, 4) = .findById("wnd[0]/usr/lbl[15," & i & "]").TextIf i Mod 29 = 0 Then '测试DELL电脑最大显示的成本中心个数，到46时 i 会报错，要填45；测试华硕电脑是要写29j = j + 1.findById("wnd[0]/usr").verticalScrollbar.Position = i * ji = 0End IfLoopEnd IfEnd IfNext xFor x = 1 To kIf IsNumeric(Right(arr2(x, 3), 1)) Thenarr2(x, 5) = FalseElsearr2(x, 5) = TrueEnd IfNext xEnd WithWith ThisWorkbook.Sheets("KSH3").AutoFilterMode = FalseWith .Cells(1, 2).Resize(1, UBound(arr2, 2)).EntireColumn.ClearContents.Resize(1, UBound(arr2, 2)) = Split("成本中心组;成本中心组名称;成本中心;成本中心名称;虚拟否", ";")If k > 0 Then .Cells(2, 1).Resize(k, UBound(arr2, 2)) = arr2End WithEnd WithIf bl ThenMsgBox "有成本中心组未查到！"ElseMsgBox "成功！"End If
End Sub

FS00

Sub FS00_整理()Dim iMg As VbMsgBoxStyleiMg = MsgBox("FS00获取科目！" & Chr(10) & " " & Chr(10), vbYesNo, "FSOO")If iMg = 7 Then Exit SubDim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As ObjectSet SapGuiAuto = GetObject("SAPGUI")Set AppSap = SapGuiAuto.GetScriptingEngineSet Connection = AppSap.Children(0)Set session = Connection.Children(0)Dim Table As Object, GetNodeK As Object, arr(), i As Integer, x'进入程式获取节点With session.findById("wnd[0]").maximize.findById("wnd[0]/tbar[0]/okcd").Text = "/NFS00".findById("wnd[0]").sendVKey 0 'EnterSet Table = .findById("wnd[0]/shellcont/shell/shellcont[1]/shell[1]")Set GetNodeK = Table.GetAllNodeKeys '得到所有的节点End With'打开所有节点For x = GetNodeK.Count - 1 To 0 Step -1Table.expandNode GetNodeK.Item(x)Next x'重新读取shell[1]Set Table = session.findById("wnd[0]/shellcont/shell/shellcont[1]/shell[1]")Set GetNodeK = Table.GetAllNodeKeys '得到所有的节点For x = 0 To GetNodeK.Count - 1i = i + 1ReDim Preserve arr(1 To i)arr(i) = GetNodeK.Item(x) '节点arr(i) = Table.getitemtext(arr(i), "&Hierarchy") '获得内容Next x'With ThisWorkbook.Sheets("FS00")'    .AutoFilterMode = False'    .UsedRange.ClearContents'    .Cells(1, 1).Resize(i) = Application.Transpose(arr)'End WithDim brr(), v, j As Integer, sr As StringReDim brr(1 To i, 1 To 4)For x = 1 To iIf InStr(1, arr(x), "  ") = 0 Thensr = arr(x)Elsej = j + 1brr(j, 1) = srbrr(j, 2) = arr(x)brr(j, 3) = Split(arr(x), "  ")(0)brr(j, 4) = Trim(Replace(arr(x), brr(j, 3), ""))End IfNext xWith ThisWorkbook.Sheets("FS00").AutoFilterMode = False.UsedRange.ClearContents.Cells(1, 1).Resize(1, UBound(brr, 2)) = Split("科目组;科目与科目描述;科目;科目描述", ";")If j > 0 Then .Cells(2, 1).Resize(j, UBound(brr, 2)) = brrEnd With
End Sub

SM30

SM30中，ZTCO0011B用于配置进销存报表，此方法在正式区读取表后又可以再测试区导入进去。

Sub SM30_ZTCO0011B_显示()Dim iMg As VbMsgBoxStyleiMg = MsgBox("是否显示ZTCO0011B？" & Chr(10) & " " & Chr(10), vbYesNo, "SM30")If iMg = 7 Then Exit SubDim x As Integer, y As Integer, sr As String, rg As Range, arr(), k As Integer, i As Integer, j As Integer, bl As BooleanDim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object, PositionSet SapGuiAuto = GetObject("SAPGUI")Set AppSap = SapGuiAuto.GetScriptingEngineSet Connection = AppSap.Children(0)Set session = Connection.Children(0)With session.findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B").verticalScrollbar.Position = 0sr = .findById("wnd[0]/usr/txtVIM_POSITION_INFO").Textj = CDbl(Split(sr, "/")(1))ReDim arr(0 To j, 1 To 6)i = -1For x = 0 To ji = i + 1arr(x, 1) = .findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B/txtZTCO0011B-BIZCODE[0," & i & "]").Textarr(x, 2) = .findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B/txtZTCO0011B-BWART[1," & i & "]").Textarr(x, 3) = .findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B/txtZTCO0011B-BIZTEXT[2," & i & "]").Textarr(x, 4) = .findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B/cmbZTCO0011B-BIZATTR[3," & i & "]").Textarr(x, 5) = .findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B/cmbZTCO0011B-SHKZG[4," & i & "]").Textarr(x, 6) = .findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B/txtZTCO0011B-SOBKZ[5," & i & "]").TextIf i Mod 19 = 0 Then.findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B").verticalScrollbar.Position = xi = 0End IfNext xEnd WithWith ThisWorkbook.Sheets("SM30_ZTCO0011B").AutoFilterMode = False.Cells.ClearContents.Cells(1, 1).Resize(1, UBound(arr, 2)) = Split("业务分类代码;MvT;业务分类描述;业务属性;借贷;特殊库存", ";").Cells(2, 1).Resize(UBound(arr), UBound(arr, 2)) = arrEnd With
End SubSub SM30_ZTCO0011B_导入()Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object, PositionSet SapGuiAuto = GetObject("SAPGUI")Set AppSap = SapGuiAuto.GetScriptingEngineSet Connection = AppSap.Children(0)Set session = Connection.Children(0)Dim d As Object, x As Integer, y As Integer, rg As Range, sr As String, v, u, i As Integer, j As Integer, k As IntegerSet d = CreateObject("scripting.dictionary")sr = "SM30_ZTCO0011B"Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")If rg Is Nothing ThenMsgBox "错误！表【" & sr & "】中无数据！"Exit SubEnd IfDim arr()arr = rg.CurrentRegion.Valued.Add "出库", "2"d.Add "入库", "1"d.Add "借方", "S"d.Add "贷方", "H"With sessioni = -1For x = 2 To UBound(arr)i = i + 1.findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B/txtZTCO0011B-BIZCODE[0," & i & "]").Text = arr(x, 1).findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B/txtZTCO0011B-BWART[1," & i & "]").Text = arr(x, 2).findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B/txtZTCO0011B-BIZTEXT[2," & i & "]").Text = arr(x, 3)If arr(x, 4) <> "" Then .findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B/cmbZTCO0011B-BIZATTR[3," & i & "]").Key = d(arr(x, 4))If arr(x, 5) <> "" Then .findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B/cmbZTCO0011B-SHKZG[4," & i & "]").Key = d(arr(x, 5)).findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B/txtZTCO0011B-SOBKZ[5," & i & "]").Text = arr(x, 6)If i Mod 19 = 0 Then.findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B").verticalScrollbar.Position = x - 2i = 0End IfNext xEnd With
End Sub

Tcode

可以新建一个收藏夹，然后获取该收藏夹的节点，维护要插入的事务码，事务码和收藏夹要进行逆序排序

节点	文件夹	事物码	事物文本
F00289	PS_1.3_项目预算增加删减流程	CJ37	项目中的预算补充
F00289	PS_1.3_项目预算增加删减流程	CJ38	项目中的预算返回
F00289	PS_1.3_项目预算增加删减流程	CJ32	改变工程发放
F00289	PS_1.3_项目预算增加删减流程	CJ33	显示项目发行
F00289	PS_1.3_项目预算增加删减流程	CJ3A	改变预算凭证
F00289	PS_1.3_项目预算增加删减流程	CJ3B	显示预算文档
F00289	PS_1.2_项目预算编列流程	CJ30	改变工程项目源预算
F00289	PS_1.2_项目预算编列流程	CJ31	显示工程项目源预算
F00289	PS_1.2_项目预算编列流程	CJ32	改变工程发放
F00289	PS_1.2_项目预算编列流程	CJ33	显示项目发行
F00289	PS_1.2_项目预算编列流程	CJ3A	改变预算凭证
F00289	PS_1.2_项目预算编列流程	CJ3B	显示预算文档
F00289	PS_1.1_WBS主数据维护流程	CJ01	生成工作细分结构
F00289	PS_1.1_WBS主数据维护流程	CJ02	更改工作细分结构
F00289	PS_1.1_WBS主数据维护流程	CJ03	显示工作细分结构
F00289	PS_1.1_WBS主数据维护流程	CJ20N	项目构建器

Sub Tcode_获取节点()Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As ObjectSet SapGuiAuto = GetObject("SAPGUI")Set AppSap = SapGuiAuto.GetScriptingEngineSet Connection = AppSap.Children(0)Set session = Connection.Children(0)Dim Table As Object, GetNodeK As Object, arr(), i As Integer, x As Integer, sr As StringReDim Title(1 To 10)'进入程式获取节点With session.findById("wnd[0]").maximize.findById("wnd[0]/tbar[0]/okcd").Text = "/N".findById("wnd[0]").sendVKey 0 'Entersr = "wnd[0]/usr/btnSTARTBUTTON"If Not session.findById(sr, False) Is Nothing Then.findById(sr).pressEnd IfSet Table = .findById("wnd[0]/usr/cntlIMAGE_CONTAINER/shellcont/shell/shellcont[0]/shell")Set GetNodeK = Table.GetAllNodeKeys '得到所有的节点End WithFor x = 0 To GetNodeK.Count - 1i = i + 1ReDim Preserve arr(1 To i)arr(i) = GetNodeK.Item(x) '节点Next xWith ThisWorkbook.Sheets("获取节点").AutoFilterMode = False.UsedRange.ClearContents.Cells(1, 1).Resize(i) = Application.Transpose(arr)End With
End SubSub Tcode_插入事物码()Dim iMg As VbMsgBoxStyleiMg = MsgBox("插入事务码！" & Chr(10) & " " & Chr(10), vbYesNo, "SAP_快速插入事务码")If iMg = 7 Then Exit SubDim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As ObjectSet SapGuiAuto = GetObject("SAPGUI")Set AppSap = SapGuiAuto.GetScriptingEngineSet Connection = AppSap.Children(0)Set session = Connection.Children(0)Dim d As Object, x As Integer, rg As Range, k As Integer, s1 As String, s2 As String, v1, v2, v3Set d = CreateObject("scripting.dictionary")Dim Table As Objects1 = "插入事务码"Set rg = ThisWorkbook.Sheets(s1).UsedRange.Find("*")If rg Is Nothing ThenMsgBox "错误！表【" & s1 & "】中无数据！"Exit SubEnd IfDim arr()arr = rg.CurrentRegion.ValueFor x = 2 To UBound(arr)s1 = arr(x, 1) '节点s2 = arr(x, 2) '文件夹名称If Not d.exists(s1) ThenSet d(s1) = CreateObject("scripting.dictionary")End IfIf Not d(s1).exists(s2) ThenSet d(s1)(s2) = CreateObject("scripting.dictionary")End Ifd(s1)(s2)(arr(x, 3)) = "" 'arr(x, 3) 是事务码Next xWith session.findById("wnd[0]").maximizeSet Table = .findById("wnd[0]/usr/cntlIMAGE_CONTAINER/shellcont/shell/shellcont[0]/shell")For Each v1 In d.keysFor Each v2 In d(v1).keysTable.selectedNode = v1Table.nodeContextMenu v1Table.selectContextMenuItem "XXFOLD" '插入文件夹.findById("wnd[1]/usr/sub:SAPLSPO4:0300/txtSVALD-VALUE[0,21]").Text = v2.findById("wnd[1]/tbar[0]/btn[0]").pressFor Each v3 In d(v1)(v2).keys.findById("wnd[0]").maximizeTable.nodeContextMenu NodeKeys(CStr(v1))Table.selectContextMenuItem "XXADTC" '插入事务码.findById("wnd[1]/usr/sub:SAPLSPO4:0300/txtSVALD-VALUE[0,21]").Text = v3.findById("wnd[1]/tbar[0]/btn[0]").pressNext v3Next v2Next v1End WithSet d = NothingMsgBox "结束！"
End SubFunction NodeKeys(s1 As String) As String '例如 要把 F00289 改成 F00290Dim i As Integer, s2 As Stringi = Len(s1)s2 = CDbl(Right(s1, i - 1)) + 1NodeKeys = "F" & Application.Rept(0, i - Len(s2) - 1) & s2
End Function

CKM3N

批量查询料号的成本价明细

CKM3N维护查询的数据
年	月	工厂	料号
2023	4	0510	G1CMX085065A-Y

Sub CKM3N_显示物料价格_跨月_多料号()On Error Resume NextDim iMg As VbMsgBoxStyleiMg = MsgBox("是否在正式区显示物料价格？" & Chr(10) & " " & Chr(10), vbYesNo, "CKM3N")If iMg = 7 Then Exit SubDim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As ObjectSet SapGuiAuto = GetObject("SAPGUI")Set AppSap = SapGuiAuto.GetScriptingEngineSet Connection = AppSap.Children(0)Set session = Connection.Children(0)Dim x As Long, y As Integer, z As Integer, sr As String, rg As Range, arr1(), bl As Boolean, db As Double, k As Long, vDim Table As Object, Columns As Object, GetNodeK As ObjectReDim arr2(1 To 100000, 1 To 29)sr = "CKM3N跨月"Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")If rg Is Nothing ThenMsgBox "错误！表【" & sr & "】中无数据！"Exit SubEnd Ifarr1 = rg.CurrentRegion.Valuebl = FalseWith sessionFor x = 2 To UBound(arr1)If arr1(x, 1) = "" Then Exit For.findById("wnd[0]").maximize.findById("wnd[0]/tbar[0]/okcd").Text = "/NCKM3N".findById("wnd[0]").sendVKey 0 'Enter.findById("wnd[0]/usr/ctxtMLKEY-WERKS_ML_PRODUCTIVE").Text = arr1(x, 3) '查询工厂.findById("wnd[0]/usr/ctxtMLKEY-MATNR").Text = arr1(x, 4) '查询物料.findById("wnd[0]/usr/txtMLKEY-POPER").Text = arr1(x, 2) '月.findById("wnd[0]/usr/txtMLKEY-BDATJ").Text = arr1(x, 1)  '年.findById("wnd[0]/tbar[1]/btn[13]").press '刷新.findById("wnd[0]/usr/btn%#AUTOTEXT003").press '折叠选择字段 价格For Each v In Split("10;32", ";") '10" '公司层面 '"32"'利润中心层面 ';32.findById("wnd[0]/usr/cmbMLKEY-CURTP").Key = v '货币/评估sr = "wnd[0]/usr/ssubSUB:SAPLCKM8H:0300/cntlCONTAINER/shellcont/shell/shellcont[1]/shell[1]"If Not .findById(sr, False) Is Nothing ThenSet Table = .findById(sr)Set Columns = Table.ColumnOrder()Set GetNodeK = Table.GetAllNodeKeys '得到所有的节点For z = 0 To GetNodeK.Count - 1k = k + 1For y = 1 To 4arr2(k, y) = arr1(x, y)Next yarr2(k, 5) = .findById("wnd[0]/usr/cmbMLKEY-CURTP").Text '货币/评估arr2(k, 6) = .findById("wnd[0]/usr/ctxtCKMLCR-VPRSV").Text '价格控制arr2(k, 7) = .findById("wnd[0]/usr/txtCKMLCR-STPRS").Text '标准价格arr2(k, 8) = .findById("wnd[0]/usr/txtCKMLCR-PVPRS").Text '定期价格 '正式区是  wnd[0]/usr/txtCKMLCR-PVPRS '测试区是 wnd[0]/usr/txtPVPRS_DYNarr2(k, 9) = .findById("wnd[0]/usr/txtCKMLCR-PEINH").Text '价格单位arr2(k, 12) = Table.getitemtext(GetNodeK.Item(z), "&Hierarchy")For y = 1 To 17arr2(k, y + 12) = Table.getitemtext(GetNodeK.Item(z), CStr(Columns(y)))Next yNext zEnd IfNext vNext xEnd WithFor x = 1 To kdb = arr2(x, 9) '价格单位If db <> 0 Thenarr2(x, 10) = arr2(x, 7) / db '标准价=标准价格/价格单位arr2(x, 11) = arr2(x, 8) / db '实际价=定期价格/价格单位End Ifarr2(x, 13) = CDbl(arr2(x, 13)) '数量For y = 15 To 29arr2(x, y) = CDbl(arr2(x, y)) '初级评估等Next yarr2(x, 3) = "'" & arr2(x, 3) '工厂Next xWith ThisWorkbook.Sheets("CKM3N跨月").AutoFilterMode = FalseWith .Cells(1, 5).Resize(1, UBound(arr2, 2)).EntireColumn.ClearContents.Resize(1, UBound(arr2, 2)) = Split("年;月;工厂;物料;货币评估;价格控制;标准价格;定期价格;价格单位;标准价;实际价;类别;数量;数量单位;初级评估;价格差异;汇率差异;实际值;价格;公司间利润;直接材料;直接人工;间接人员薪资及福利;模具及治工具;资产摊提及能源消耗;耗品及杂项消耗;其他费用;委外加工;成本构成总和", ";")If k > 0 Then .Cells(2, 1).Resize(k, UBound(arr2, 2)) = arr2End WithEnd With
End Sub

CKM3N自行输入料号查询，只能开一个屏，否则会报错，可以自己打开节点，看想要的内容

Sub CKM3N_显示物料价格_明细_单月单笔()Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As ObjectSet SapGuiAuto = GetObject("SAPGUI")Set AppSap = SapGuiAuto.GetScriptingEngineSet Connection = AppSap.Children(0)Set session = Connection.Children(0)Dim x As Integer, y As Integer, z As Integer, sr As String, rg As Range, arr1(), k As Integer, brr(), bl As BooleanDim Table As Object, Columns As Object, GetNodeK As ObjectReDim arr2(1 To 100000, 1 To 18) '此处要提前知道列数，并且加了一列 'Table.ColumnCount()With sessionSet Table = .findById("wnd[0]/usr/ssubSUB:SAPLCKM8H:0300/cntlCONTAINER/shellcont/shell/shellcont[1]/shell[1]")Set Columns = Table.ColumnOrder()Set GetNodeK = Table.GetAllNodeKeys '得到所有的节点For x = 0 To GetNodeK.Count - 1k = k + 1arr2(k, 1) = Table.getitemtext(GetNodeK.Item(x), "&Hierarchy")For y = 1 To 17 'Table.ColumnCount() - 1arr2(k, y + 1) = Table.getitemtext(GetNodeK.Item(x), CStr(Columns(y)))Next yNext xFor x = 1 To kFor y = 2 To UBound(arr2, 2)If y <> 3 ThenIf arr2(x, y) = "" Thenarr2(x, y) = 0Elsearr2(x, y) = CDbl(arr2(x, y))End IfEnd IfNext yNext xEnd WithWith ThisWorkbook.Sheets("CKM3N明细").AutoFilterMode = False.UsedRange.ClearContents.Cells(1, 1).Resize(1, UBound(arr2, 2)) = Split("类别;数量;数量单位;初级评估;价格差异;汇率差异;实际值;价格;公司间利润;直接材料;直接人工;间接人员薪资及福利;模具及治工具;资产摊提及能源消耗;耗品及杂项消耗;其他费用;委外加工;成本构成总和", ";")If k > 0 Then .Cells(2, 1).Resize(k, UBound(arr2, 2)) = arr2End With
End Sub

FB02

FB02批量修改凭证文本的摘要


Sub FB02_修改凭证文本栏位()Dim iMg As VbMsgBoxStyleiMg = MsgBox("是否修改凭证文本栏位？" & Chr(10) & " " & Chr(10), vbYesNo, "FB02")If iMg = 7 Then Exit SubDim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As ObjectSet SapGuiAuto = GetObject("SAPGUI")Set AppSap = SapGuiAuto.GetScriptingEngineSet Connection = AppSap.Children(0)Set session = Connection.Children(0)Dim Table As Object, Columns As ObjectDim arr1(), x As Integer, y As Integer, z As Integer, sr As String, rg As Rangesr = "FB02"Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")If rg Is Nothing ThenMsgBox "错误！表【" & sr & "】中无数据！"Exit SubEnd Ifarr1 = rg.CurrentRegion.ValueWith sessionFor z = 2 To UBound(arr1).findById("wnd[0]").maximize.findById("wnd[0]/tbar[0]/okcd").Text = "/NFB02" '修改凭证.findById("wnd[0]").sendVKey 0.findById("wnd[0]/usr/txtRF05L-BELNR").Text = arr1(z, 3) '凭证编号.findById("wnd[0]/usr/ctxtRF05L-BUKRS").Text = arr1(z, 2) '公司代码.findById("wnd[0]/usr/txtRF05L-GJAHR").Text = arr1(z, 1) '会计年度.findById("wnd[0]").sendVKey 0'.findById("wnd[0]/usr/cntlCTRL_CONTAINERBSEG/shellcont/shell").selectColumn "SGTXT" '选中“文本”栏位'.findById("wnd[0]/usr/cntlCTRL_CONTAINERBSEG/shellcont/shell").pressToolbarButton "&SORT_DSC" '排序'.findById("wnd[0]/tbar[1]/btn[25]").press '更改模式Set Table = .findById("wnd[0]/usr/cntlCTRL_CONTAINERBSEG/shellcont/shell")Set Columns = Table.ColumnOrder()For x = 0 To Table.RowCount() - 1If Table.getcellvalue(x, "SGTXT") = arr1(z, 4) Then '原文本Table.SetCurrentCell x, "KTONR"Table.doubleClickCurrentCell '双击.findById("wnd[0]/usr/ctxtBSEG-SGTXT").Text = arr1(z, 5) '更改后文本.findById("wnd[0]/tbar[0]/btn[3]").press '返回End IfIf x Mod 14 = 0 Then '屏幕上显示的最大行数，根据电脑的不同可能有变Table.SetCurrentCell x, CStr(Columns(0))Table.firstVisibleRow = xEnd IfNext x.findById("wnd[0]/tbar[0]/btn[11]").press '保存Next zEnd With
End Sub

KSU1

可以创建分摊规则，这里主要还是用成本中心分摊，其他栏位情况没考虑

Sub KSU1_标题()Dim arr() As Stringarr = Split("循环名;循环名描述;开始时间;结束时间;段名;段名描述;发送者成本中心从;发送者成本中心至;发送者成本中心组;接收方成本中心从;接收方成本中心至;接收方成本中心组", ";")With ThisWorkbook.Sheets("KSU1").AutoFilterMode = False.Cells(1, 1).Resize(1, UBound(arr) + 1) = arrEnd With
End SubSub KSU1_创建实际分摊()Dim iMg As VbMsgBoxStyleiMg = MsgBox("是否创建实际分摊？" & Chr(10) & " " & Chr(10), vbYesNo, "KSU1")If iMg = 7 Then Exit SubDim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As ObjectSet SapGuiAuto = GetObject("SAPGUI")Set AppSap = SapGuiAuto.GetScriptingEngineSet Connection = AppSap.Children(0)Set session = Connection.Children(0)Dim x As Integer, sr As String, rg As Range, arr1()sr = "KSU1"Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")If rg Is Nothing ThenMsgBox "错误！表【" & sr & "】中无数据！"Exit SubEnd Ifarr1 = rg.CurrentRegion.ValueWith session.findById("wnd[0]").maximize.findById("wnd[0]/tbar[0]/okcd").Text = "/NKSU1" '创建实际分摊.findById("wnd[0]").sendVKey 0 'Enter.findById("wnd[0]/usr/ctxtRKAL1-KSCYC").Text = arr1(2, 1) '循环名.findById("wnd[0]/usr/ctxtT811C-SDATE").Text = arr1(2, 3)  '开始时间.findById("wnd[0]").sendVKey 0 'Enter.findById("wnd[0]/usr/ctxtT811C-EDATE").Text = arr1(2, 4) '结束时间.findById("wnd[0]/usr/txtRKAL1-CTXT").Text = arr1(2, 2) '循环名描述For x = 2 To UBound(arr1).findById("wnd[0]/tbar[1]/btn[20]").press '增加段.findById("wnd[0]/usr/txtKGALS-NAME").Text = arr1(x, 5) '段名.findById("wnd[0]/usr/txtKGALS-TXT").Text = arr1(x, 6) '段名描述.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSQHD/ssubSUB1:SAPMKAL1:0307/ctxtKGALS-ABSCH").Text = "Z3" '分配结构.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSQHD/ssubSUB1:SAPMKAL1:0307/cmbRKAL1-RCDATAFLG").Key = "7" '可变部分类型.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS").Select '发送方/接收方.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[4,67]").Text = "ZZ00" '成本要素组 '修改.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMIN[1,17]").Text = arr1(x, 7)  '发送者成本中心从.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMAX[1,42]").Text = arr1(x, 8) '发送者成本中心至.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[1,67]").Text = arr1(x, 9) '发送者成本中心组.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMIN[7,17]").Text = arr1(x, 10) '接收方成本中心从.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMAX[7,42]").Text = arr1(x, 11)  '接收方成本中心至.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[7,67]").Text = arr1(x, 12)   '接收方成本中心组.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSEND").Select '发送方值.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSEND/ssubSUB1:SAPMKAL1:0451/sub:SAPMKAL1:0451/ctxtKGALK-VALMIN[0,17]").Text = "0" '版本.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE").Select '接收方追踪因素.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE/ssubSUB1:SAPMKAL1:0461/sub:SAPMKAL1:0461/ctxtKGALK-VALMIN[0,17]").Text = "ZZ01" '活动类型：从.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE/ssubSUB1:SAPMKAL1:0461/sub:SAPMKAL1:0461/ctxtKGALK-VALMAX[0,42]").Text = "ZZ06" '活动类型：到.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRWFC").Select '参考加权因素Next xEnd WithMsgBox "运行成功！"
End Sub

KSU2

修改已经创建的分摊规则

Sub KSU2_标题()Dim arr() As Stringarr = Split("查询循环名;查询开始时间;修改结束时间;修改循环名描述;修改段名;修改段名描述;修改发送者成本中心从;修改发送者成本中心至;修改发送者成本中心组;修改接收方成本中心从;修改接收方成本中心至;修改接收方成本中心组", ";")With ThisWorkbook.Sheets("KSU2").AutoFilterMode = False.Cells(1, 1).Resize(1, UBound(arr) + 1) = arrEnd With
End SubSub KSU2_修改实际分摊()Dim iMg As VbMsgBoxStyleiMg = MsgBox("是否修改实际分摊？" & Chr(10) & " " & Chr(10), vbYesNo, "KSU2")If iMg = 7 Then Exit SubDim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As ObjectSet SapGuiAuto = GetObject("SAPGUI")Set AppSap = SapGuiAuto.GetScriptingEngineSet Connection = AppSap.Children(0)Set session = Connection.Children(0)Dim x As Integer, sr As String, rg As Range, arr1(), arr2(), brr(), k As Long, iMax As Integer, i As Integer, j As IntegerReDim arr2(1 To 100000, 1 To 18)ReDim brr(1 To 3)sr = "KSU2"Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")If rg Is Nothing ThenMsgBox "错误！表【" & sr & "】中无数据！"Exit SubEnd Ifarr1 = rg.CurrentRegion.ValueWith session.findById("wnd[0]").maximize.findById("wnd[0]/tbar[0]/okcd").Text = "/NKSU2" '修改实际分配.findById("wnd[0]").sendVKey 0 'Enter.findById("wnd[0]/usr/ctxtRKAL1-KSCYC").Text = arr1(2, 1) '循环名.findById("wnd[0]/usr/ctxtT811C-SDATE").Text = arr1(2, 2) '开始日期.findById("wnd[0]").sendVKey 0 'Enter.findById("wnd[0]/usr/ctxtT811C-EDATE").Text = arr1(2, 3) '结束时间.findById("wnd[0]/usr/txtRKAL1-CTXT").Text = arr1(2, 4) '循环名描述.findById("wnd[0]/tbar[1]/btn[6]").press '第一个段.findById("wnd[0]/mbar/menu[2]/menu[1]").Select '转到>>概述段j = .findById("wnd[1]/usr/txtRCEVM-ENTRIES").Text '段号.findById("wnd[1]/tbar[0]/btn[12]").press '取消段概览For x = 1 To j '为了修改的时候不重名.findById("wnd[0]/usr/txtKGALS-NAME").Text = xIf x <> j Then .findById("wnd[0]/tbar[1]/btn[19]").press '下一段Next xFor x = 1 To j - 1 '回退到第一个段.findById("wnd[0]/tbar[1]/btn[18]").press '前一段Next xFor x = 2 To UBound(arr1)i = i + 1.findById("wnd[0]/usr/txtKGALS-NAME").Text = arr1(x, 5) '段名 （不能大于十个字符）.findById("wnd[0]/usr/txtKGALS-TXT").Text = arr1(x, 6) '段名描述.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSQHD/ssubSUB1:SAPMKAL1:0307/ctxtKGALS-ABSCH").Text = "Z3" '分配结构.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSQHD/ssubSUB1:SAPMKAL1:0307/cmbRKAL1-RCDATAFLG").Key = "7" '可变部分类型.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS").Select '发送方/接收方.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[4,67]").Text = "ZZ00" '成本要素组.findById("wnd[0]/usr/chkKGALS-ACTIVE").Selected = False '锁定标识符.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMIN[1,17]").Text = arr1(x, 7)  '发送者成本中心从.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMAX[1,42]").Text = arr1(x, 8) '发送者成本中心至.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[1,67]").Text = arr1(x, 9) '发送者成本中心组.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMIN[7,17]").Text = arr1(x, 10) '接收方成本中心从.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMAX[7,42]").Text = arr1(x, 11)  '接收方成本中心至.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[7,67]").Text = arr1(x, 12)   '接收方成本中心组.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSEND").Select '发送方值.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSEND/ssubSUB1:SAPMKAL1:0451/sub:SAPMKAL1:0451/ctxtKGALK-VALMIN[0,17]").Text = "0" '版本.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE").Select '接收方追踪因素.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE/ssubSUB1:SAPMKAL1:0461/sub:SAPMKAL1:0461/ctxtKGALK-VALMIN[0,17]").Text = "ZZ01" '活动类型：从.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE/ssubSUB1:SAPMKAL1:0461/sub:SAPMKAL1:0461/ctxtKGALK-VALMAX[0,42]").Text = "ZZ06" '活动类型：到.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRWFC").Select '参考加权因素If x = UBound(arr1) ThenElseIf i < j Then.findById("wnd[0]/tbar[1]/btn[19]").pressElse.findById("wnd[0]/tbar[1]/btn[20]").press '增加段End IfNext xDo While i < j '如果没有修改的必要则全部锁定掉i = i + 1.findById("wnd[0]/tbar[1]/btn[19]").press '下一个段.findById("wnd[0]/usr/chkKGALS-ACTIVE").Selected = "TRUE" '锁定标识符LoopEnd WithMsgBox "请自行保存！"
End Sub

KSU3

显示分摊规则

查询循环名	查询开始时间
C12101	2022.06.01

Sub KSU3_标题()Dim arr() As Stringarr = Split("查询循环名;查询开始时间;循环名;循环名描述;开始时间;结束时间;段名;段名描述;锁定标识符;分配结构;可变部分类型;成本要素组;发送者成本中心从;发送者成本中心至;发送者成本中心组;接收方成本中心从;接收方成本中心至;接收方成本中心组;版本;活动类型从;活动类型到", ";")With ThisWorkbook.Sheets("KSU3").AutoFilterMode = False.Cells(1, 1).Resize(1, UBound(arr) + 1) = arrEnd With
End SubSub KSU3_显示实际分摊()Dim iMg As VbMsgBoxStyleiMg = MsgBox("是否显示实际分摊？" & Chr(10) & " " & Chr(10), vbYesNo, "KSU3")If iMg = 7 Then Exit SubDim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As ObjectSet SapGuiAuto = GetObject("SAPGUI")Set AppSap = SapGuiAuto.GetScriptingEngineSet Connection = AppSap.Children(0)Set session = Connection.Children(0)Dim x As Integer, sr As String, rg As Range, arr1(), arr2(), brr(), k As Long, iMax As Integer, i As Integer, j As IntegerReDim arr2(1 To 100000, 1 To 19)ReDim brr(1 To 3)sr = "KSU3"Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")If rg Is Nothing ThenMsgBox "错误！表【" & sr & "】中无数据！"Exit SubEnd Ifarr1 = rg.CurrentRegion.ValueWith sessionFor x = 2 To UBound(arr1)If arr1(x, 1) <> "" Then.findById("wnd[0]").maximize.findById("wnd[0]/tbar[0]/okcd").Text = "/NKSU3" '显示实际分摊.findById("wnd[0]").sendVKey 0 'Enter.findById("wnd[0]/usr/ctxtRKAL1-KSCYC").Text = arr1(x, 1) '循环名.findById("wnd[0]/usr/ctxtT811C-SDATE").Text = arr1(x, 2) '开始日期.findById("wnd[0]").sendVKey 0 'Enterbrr(1) = .findById("wnd[0]/usr/txtRKAL1-CTXT").Text   '循环名描述brr(2) = .findById("wnd[0]/usr/ctxtT811C-SDATE").Text '开始时间brr(3) = .findById("wnd[0]/usr/ctxtT811C-EDATE").Text '结束时间.findById("wnd[0]/tbar[1]/btn[6]").press '第一个段.findById("wnd[0]/mbar/menu[2]/menu[1]").Select '转到>>概述段j = .findById("wnd[1]/usr/txtRCEVM-ENTRIES").Text '段号.findById("wnd[1]/tbar[0]/btn[12]").press '取消段概览i = 0DoOn Error Resume Nextk = k + 1i = i + 1arr2(k, 1) = arr1(x, 1)arr2(k, 2) = brr(1)arr2(k, 3) = brr(2)arr2(k, 4) = brr(3)arr2(k, 5) = .findById("wnd[0]/usr/txtKGALS-NAME").Text  '段名arr2(k, 6) = .findById("wnd[0]/usr/txtKGALS-TXT").Text '段名描述arr2(k, 7) = .findById("wnd[0]/usr/chkKGALS-ACTIVE").Selected '锁定标识符arr2(k, 8) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSQHD/ssubSUB1:SAPMKAL1:0307/ctxtKGALS-ABSCH").Text '分配结构arr2(k, 9) = Trim(.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSQHD/ssubSUB1:SAPMKAL1:0307/cmbRKAL1-RCDATAFLG").Text) '可变部分类型.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS").Select '发送方/接收方arr2(k, 10) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[4,67]").Text '成本要素组arr2(k, 11) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMIN[1,17]").Text '发送者成本中心从arr2(k, 12) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMAX[1,42]").Text '发送者成本中心至arr2(k, 13) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[1,67]").Text '发送者成本中心组arr2(k, 14) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMIN[7,17]").Text  '接收方成本中心从arr2(k, 15) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMAX[7,42]").Text '接收方成本中心至arr2(k, 16) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[7,67]").Text   '接收方成本中心组.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSEND").Select '发送方值arr2(k, 17) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSEND/ssubSUB1:SAPMKAL1:0451/sub:SAPMKAL1:0451/ctxtKGALK-VALMIN[0,17]").Text '版本.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE").Select  '接收方追踪因素arr2(k, 18) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE/ssubSUB1:SAPMKAL1:0461/sub:SAPMKAL1:0461/ctxtKGALK-VALMIN[0,17]").Text  '活动类型：从arr2(k, 19) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE/ssubSUB1:SAPMKAL1:0461/sub:SAPMKAL1:0461/ctxtKGALK-VALMAX[0,42]").Text     '活动类型：到.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRWFC").Select        '参考加权因素.findById("wnd[0]/tbar[1]/btn[19]").pressLoop Until i >= j.findById("wnd[1]/tbar[0]/btn[0]").pressEnd IfNext xEnd WithWith ThisWorkbook.Sheets("KSU3").AutoFilterMode = FalseWith .Cells(1, 3).Resize(1, UBound(arr2, 2)).EntireColumn.ClearContents.Resize(1, UBound(arr2, 2)) = Split("循环名;循环名描述;开始时间;结束时间;段名;段名描述;锁定标识符;分配结构;可变部分类型;成本要素组;发送者成本中心从;发送者成本中心至;发送者成本中心组;接收方成本中心从;接收方成本中心至;接收方成本中心组;版本;活动类型从;活动类型到", ";")If k > 0 Then .Cells(2, 1).Resize(k, UBound(arr2, 2)) = arr2End WithEnd WithMsgBox "成功"
End Sub

KSV1、KSV2、KSV3

分配

Sub KSV1_创建实际分配()Dim iMg As VbMsgBoxStyleiMg = MsgBox("是否创建实际分配？" & Chr(10) & " " & Chr(10), vbYesNo, "KSV1")If iMg = 7 Then Exit SubDim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As ObjectSet SapGuiAuto = GetObject("SAPGUI")Set AppSap = SapGuiAuto.GetScriptingEngineSet Connection = AppSap.Children(0)Set session = Connection.Children(0)Dim x As Integer, sr As String, rg As Range, arr1()sr = "KSV1"Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")If rg Is Nothing ThenMsgBox "错误！表【" & sr & "】中无数据！"Exit SubEnd Ifarr1 = rg.CurrentRegion.ValueWith session.findById("wnd[0]").maximize.findById("wnd[0]/tbar[0]/okcd").Text = "/NKSV1" '创建实际分摊.findById("wnd[0]").sendVKey 0 'Enter.findById("wnd[0]/usr/ctxtRKAL1-KSCYC").Text = arr1(2, 1) '循环名.findById("wnd[0]/usr/ctxtT811C-SDATE").Text = arr1(2, 3)  '开始时间.findById("wnd[0]").sendVKey 0 'Enter.findById("wnd[0]/usr/ctxtT811C-EDATE").Text = arr1(2, 4) '结束时间.findById("wnd[0]/usr/txtRKAL1-CTXT").Text = arr1(2, 2) '循环名描述For x = 2 To UBound(arr1).findById("wnd[0]/tbar[1]/btn[20]").press '增加段.findById("wnd[0]/usr/txtKGALS-NAME").Text = arr1(x, 5) '段名.findById("wnd[0]/usr/txtKGALS-TXT").Text = arr1(x, 6) '段名描述.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSQHD/ssubSUB1:SAPMKAL1:0308/cmbRKAL1-RCDATAFLG").Key = "7" '可变部分类型.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS").Select '发送方/接收方.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[3,67]").Text = "ZZ00" '成本要素组.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMIN[1,17]").Text = arr1(x, 7)  '发送者成本中心从.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMAX[1,42]").Text = arr1(x, 8) '发送者成本中心至.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[1,67]").Text = arr1(x, 9) '发送者成本中心组.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMIN[7,17]").Text = arr1(x, 10) '接收方成本中心从.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMAX[7,42]").Text = arr1(x, 11)  '接收方成本中心至.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[7,67]").Text = arr1(x, 12)   '接收方成本中心组.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSEND").Select '发送方值.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSEND/ssubSUB1:SAPMKAL1:0451/sub:SAPMKAL1:0451/ctxtKGALK-VALMIN[0,17]").Text = "0" '版本.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE").Select '接收方追踪因素.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE/ssubSUB1:SAPMKAL1:0461/sub:SAPMKAL1:0461/ctxtKGALK-VALMIN[0,17]").Text = "ZZ01" '活动类型：从.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE/ssubSUB1:SAPMKAL1:0461/sub:SAPMKAL1:0461/ctxtKGALK-VALMAX[0,42]").Text = "ZZ06" '活动类型：到.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRWFC").Select '参考加权因素Next xEnd WithMsgBox "运行成功！"
End SubSub KSV3_显示实际分配()Dim iMg As VbMsgBoxStyleiMg = MsgBox("是否显示实际分配？" & Chr(10) & " " & Chr(10), vbYesNo, "KSV3")If iMg = 7 Then Exit SubDim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As ObjectSet SapGuiAuto = GetObject("SAPGUI")Set AppSap = SapGuiAuto.GetScriptingEngineSet Connection = AppSap.Children(0)Set session = Connection.Children(0)Dim x As Integer, sr As String, rg As Range, arr1(), arr2(), brr(), k As Long, iMax As Integer, i As Integer, j As IntegerReDim arr2(1 To 100000, 1 To 18)ReDim brr(1 To 3)sr = "KSV3"Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")If rg Is Nothing ThenMsgBox "错误！表【" & sr & "】中无数据！"Exit SubEnd Ifarr1 = rg.CurrentRegion.ValueWith sessionFor x = 2 To UBound(arr1)If arr1(x, 1) <> "" Then.findById("wnd[0]").maximize.findById("wnd[0]/tbar[0]/okcd").Text = "/NKSV3" '显示实际分配.findById("wnd[0]").sendVKey 0 'Enter.findById("wnd[0]/usr/ctxtRKAL1-KSCYC").Text = arr1(x, 1) '循环名.findById("wnd[0]/usr/ctxtT811C-SDATE").Text = arr1(x, 2) '开始日期.findById("wnd[0]").sendVKey 0 'Enterbrr(1) = .findById("wnd[0]/usr/txtRKAL1-CTXT").Text   '循环名描述brr(2) = .findById("wnd[0]/usr/ctxtT811C-SDATE").Text '开始时间brr(3) = .findById("wnd[0]/usr/ctxtT811C-EDATE").Text '结束时间.findById("wnd[0]/tbar[1]/btn[6]").press '第一个段.findById("wnd[0]/mbar/menu[2]/menu[1]").Select '转到>>概述段j = .findById("wnd[1]/usr/txtRCEVM-ENTRIES").Text '段号.findById("wnd[1]/tbar[0]/btn[12]").press '取消段概览i = 0DoOn Error Resume Nextk = k + 1i = i + 1arr2(k, 1) = arr1(x, 1)arr2(k, 2) = brr(1)arr2(k, 3) = brr(2)arr2(k, 4) = brr(3)arr2(k, 5) = .findById("wnd[0]/usr/txtKGALS-NAME").Text  '段名arr2(k, 6) = .findById("wnd[0]/usr/txtKGALS-TXT").Text '段名描述arr2(k, 7) = .findById("wnd[0]/usr/chkKGALS-ACTIVE").Selected '锁定标识符arr2(k, 8) = Trim(.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSQHD/ssubSUB1:SAPMKAL1:0308/cmbRKAL1-RCDATAFLG").Text) '可变部分类型.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS").Select '发送方/接收方arr2(k, 9) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[3,67]").Text '成本要素组arr2(k, 10) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMIN[1,17]").Text '发送者成本中心从arr2(k, 11) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMAX[1,42]").Text '发送者成本中心至arr2(k, 12) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[1,67]").Text '发送者成本中心组arr2(k, 13) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMIN[7,17]").Text  '接收方成本中心从arr2(k, 14) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMAX[7,42]").Text '接收方成本中心至arr2(k, 15) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[7,67]").Text   '接收方成本中心组.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSEND").Select '发送方值arr2(k, 16) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSEND/ssubSUB1:SAPMKAL1:0451/sub:SAPMKAL1:0451/ctxtKGALK-VALMIN[0,17]").Text '版本.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE").Select  '接收方追踪因素arr2(k, 17) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE/ssubSUB1:SAPMKAL1:0461/sub:SAPMKAL1:0461/ctxtKGALK-VALMIN[0,17]").Text  '活动类型：从arr2(k, 18) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE/ssubSUB1:SAPMKAL1:0461/sub:SAPMKAL1:0461/ctxtKGALK-VALMAX[0,42]").Text     '活动类型：到.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRWFC").Select        '参考加权因素.findById("wnd[0]/tbar[1]/btn[19]").pressLoop Until i >= j.findById("wnd[1]/tbar[0]/btn[0]").pressEnd IfNext xEnd WithWith ThisWorkbook.Sheets("KSV3").AutoFilterMode = FalseWith .Cells(1, 3).Resize(1, UBound(arr2, 2)).EntireColumn.ClearContents.Resize(1, UBound(arr2, 2)) = Split("循环名;循环名描述;开始时间;结束时间;段名;段名描述;锁定标识符;可变部分类型;成本要素组;发送者成本中心从;发送者成本中心至;发送者成本中心组;接收方成本中心从;接收方成本中心至;接收方成本中心组;版本;活动类型从;活动类型到", ";")If k > 0 Then .Cells(2, 1).Resize(k, UBound(arr2, 2)) = arr2End WithEnd WithMsgBox "成功"
End SubSub KSV2_修改实际分配()Dim iMg As VbMsgBoxStyleiMg = MsgBox("是否修改实际分配？" & Chr(10) & " " & Chr(10), vbYesNo, "KSV2")If iMg = 7 Then Exit SubDim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As ObjectSet SapGuiAuto = GetObject("SAPGUI")Set AppSap = SapGuiAuto.GetScriptingEngineSet Connection = AppSap.Children(0)Set session = Connection.Children(0)Dim x As Integer, sr As String, rg As Range, arr1(), arr2(), brr(), k As Long, iMax As Integer, i As Integer, j As IntegerReDim arr2(1 To 100000, 1 To 18)ReDim brr(1 To 3)sr = "KSV2"Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")If rg Is Nothing ThenMsgBox "错误！表【" & sr & "】中无数据！"Exit SubEnd Ifarr1 = rg.CurrentRegion.ValueWith session.findById("wnd[0]").maximize.findById("wnd[0]/tbar[0]/okcd").Text = "/NKSV2" '修改实际分配.findById("wnd[0]").sendVKey 0 'Enter.findById("wnd[0]/usr/ctxtRKAL1-KSCYC").Text = arr1(2, 1) '循环名.findById("wnd[0]/usr/ctxtT811C-SDATE").Text = arr1(2, 2) '开始日期.findById("wnd[0]").sendVKey 0 'Enter.findById("wnd[0]/usr/ctxtT811C-EDATE").Text = arr1(2, 3) '结束时间.findById("wnd[0]/usr/txtRKAL1-CTXT").Text = arr1(2, 4) '循环名描述.findById("wnd[0]/tbar[1]/btn[6]").press '第一个段.findById("wnd[0]/mbar/menu[2]/menu[1]").Select '转到>>概述段j = .findById("wnd[1]/usr/txtRCEVM-ENTRIES").Text '段号.findById("wnd[1]/tbar[0]/btn[12]").press '取消段概览For x = 1 To j '为了修改的时候不重名.findById("wnd[0]/usr/txtKGALS-NAME").Text = xIf x <> j Then .findById("wnd[0]/tbar[1]/btn[19]").press '下一段Next xFor x = 1 To j - 1 '回退到第一个段.findById("wnd[0]/tbar[1]/btn[18]").press '前一段Next xFor x = 2 To UBound(arr1)i = i + 1.findById("wnd[0]/usr/txtKGALS-NAME").Text = arr1(x, 5) '段名 （不能大于十个字符）.findById("wnd[0]/usr/txtKGALS-TXT").Text = arr1(x, 6) '段名描述.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSQHD/ssubSUB1:SAPMKAL1:0308/cmbRKAL1-RCDATAFLG").Key = "7" '可变部分类型.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS").Select '发送方/接收方.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[3,67]").Text = "ZZ00" '成本要素组.findById("wnd[0]/usr/chkKGALS-ACTIVE").Selected = arr1(x, 7) '锁定标识符.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMIN[1,17]").Text = arr1(x, 8)  '发送者成本中心从.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMAX[1,42]").Text = arr1(x, 9) '发送者成本中心至.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[1,67]").Text = arr1(x, 10) '发送者成本中心组.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMIN[7,17]").Text = arr1(x, 11) '接收方成本中心从.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMAX[7,42]").Text = arr1(x, 12)  '接收方成本中心至.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[7,67]").Text = arr1(x, 13)   '接收方成本中心组.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSEND").Select '发送方值.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSEND/ssubSUB1:SAPMKAL1:0451/sub:SAPMKAL1:0451/ctxtKGALK-VALMIN[0,17]").Text = "0" '版本.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE").Select '接收方追踪因素.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE/ssubSUB1:SAPMKAL1:0461/sub:SAPMKAL1:0461/ctxtKGALK-VALMIN[0,17]").Text = "ZZ01" '活动类型：从.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE/ssubSUB1:SAPMKAL1:0461/sub:SAPMKAL1:0461/ctxtKGALK-VALMAX[0,42]").Text = "ZZ06" '活动类型：到.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRWFC").Select '参考加权因素If x = UBound(arr1) ThenElseIf i < j Then.findById("wnd[0]/tbar[1]/btn[19]").pressElse.findById("wnd[0]/tbar[1]/btn[20]").press '增加段End IfNext xDo While i < j '如果没有修改的必要则全部锁定掉i = i + 1.findById("wnd[0]/tbar[1]/btn[19]").press '下一个段.findById("wnd[0]/usr/chkKGALS-ACTIVE").Selected = "TRUE" '锁定标识符LoopEnd WithMsgBox "成功"
End Sub

与其他方式对比

RPA脚本运行时不能操作键盘鼠标，VBA运行时可以操作SAP的其他界面，操作键盘鼠标也没影响。
RPA 比如勾选复选框后需要等待程式运行，VBA不用
VBA是在简体版本的Excel运行，与繁体版的Excel不通用，中文会有乱码。
RPA运用更广泛，可以在其他应用运行。
与Tricentis对比