devbox
花生_TL007
这个屌丝很懒，什么也没留下！
关注作者
热门标签
热门文章
当前位置:   article > 正文

【SAP GUI 脚本 VBA】_sap脚本

作者：花生_TL007 | 2024-05-31 08:02:18

赞

踩

sap脚本

目录

启用 SAP脚本

Tracker

Excel启用VBA

对象声明

用法

TEXT文本

Press点击

Key选择

Selected复选框

判断字段是否存在

VerticalScrollbar 滑动滚动条

Enter

粘贴剪贴板

读取shell

读取shell[1]

VBS登入SAP

 实例

函数-提取Tcode 

 登入开发区

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的话会报错，并要调试。

  1.    Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object
  2.     Set SapGuiAuto = GetObject("SAPGUI")
  3.     Set AppSap = SapGuiAuto.GetScriptingEngine
  4.     Set Connection = AppSap.Children(0)
  5.     Set session = Connection.Children(0)

 如果没进SAP的话，改成MsgBox提醒错误

  1.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object
  2.     On Error Resume Next
  3.     Set SapGuiAuto = GetObject("SAPGUI")
  4.     Set AppSap = SapGuiAuto.GetScriptingEngine
  5.     Set Connection = AppSap.Children(0)
  6.     Set session = Connection.Children(0)
  7.     If Err > 0 Then
  8.         MsgBox "请检查是否登入SAP", vbExclamation
  9.         Exit Sub
  10.     End If
  11.     On Error GoTo 0

定义函数直接调用，更方便

  1. Public session As Object
  2.  
  3. Function MyConnectSAP() As Boolean
  4.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object
  5.     
  6.     On Error Resume Next
  7.     Set SapGuiAuto = GetObject("SAPGUI")
  8.     Set AppSap = SapGuiAuto.GetScriptingEngine
  9.     Set Connection = AppSap.Children(0)
  10.     Set session = Connection.Children(0)
  11.     
  12.     If Err > 0 Then
  13.         MsgBox "请检查是否登入SAP", vbExclamation
  14.         MyConnectSAP = True
  15.     Else
  16.         MyConnectSAP = False
  17.     End If
  18.     
  19.     Set SapGuiAuto = Nothing
  20.     Set AppSap = Nothing
  21.     Set Connection = Nothing
  22. End Function

用法

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表示判断某个字段确实不存在

  1. If Not session.findById("wnd[2]/usr/txtMESSTXT1", False) Is Nothing Then
  2.  
  3. End If

VerticalScrollbar 滑动滚动条

16代表一次滑动16个栏位

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

Enter

输入Enter键

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

粘贴剪贴板

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

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

读取shell

  1. '读取shell时不同于text，要通过循环取值
  2. '把取到的shell赋值给Table
  3. 'Table.RowCount表示总行数
  4. 'Table.ColumnCount表示总列数
  5. 'Table.ColumnOrder可以取列名
  6. 'Table.getcellvalue 可以取表的值
  7. '例如此处把取到的Table传到了数组arr里，然后在读取到Excel中
  8.  
  9. Dim x As Integer, y As Integer, k As Integer, arr(), Title()
  10. ReDim arr(1 To 100000, 1 To 15)
  11. ReDim Title(1 To 15)
  12.  
  13. With session
  14.     Set Table = .findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell")
  15.     Set Columns = Table.ColumnOrder() '取列
  16.     For x = 0 To Table.RowCount() - 1 'Table.RowCount表示为总行数
  17.         k = k + 1
  18.         For y = 0 To Table.ColumnCount() - 1
  19.             arr(k, y + 1) = Table.getcellvalue(x, CStr(Columns(y))) '取值
  20.         Next y
  21.     Next x
  22.     For y = 0 To Table.ColumnCount() - 1
  23.         Title(y + 1) = CStr(Columns(y)) 'Columns返回标题文本
  24.     Next y
  25. End With

读取shell[1]

  1.     '读取shell[1]里隐藏的内容时需要打开节点
  2.     'Table.GetAllNodeKeys 表示所有的节点，返回值是数字
  3.     'Table.expandNode 打开节点
  4.     'Table.GetAllNodeKeys.Count 表示总节点数
  5.     'Table.getitemtext 可以获取内容
  6.     
  7.     Dim Table As Object, GetNodeK As Object, arr(), i As Integer, x
  8.     
  9.     '进入程式获取节点
  10.     With session
  11.         .findById("wnd[0]").maximize
  12.         .findById("wnd[0]/tbar[0]/okcd").Text = "/NFS00"
  13.         .findById("wnd[0]").sendVKey 0 'Enter
  14.         Set Table = .findById("wnd[0]/shellcont/shell/shellcont[1]/shell[1]")
  15.         Set GetNodeK = Table.GetAllNodeKeys '得到所有的节点
  16.     End With
  17.     
  18.     '打开所有节点
  19.     For x = GetNodeK.Count - 1 To 0 Step -1
  20.         Table.expandNode GetNodeK.Item(x)
  21.     Next x
  22.     
  23.     '重新读取shell[1]
  24.     Set Table = session.findById("wnd[0]/shellcont/shell/shellcont[1]/shell[1]")
  25.     Set GetNodeK = Table.GetAllNodeKeys '得到所有的节点
  26.     For x = 0 To GetNodeK.Count - 1
  27.         i = i + 1
  28.         ReDim Preserve arr(1 To i)
  29.         arr(i) = GetNodeK.Item(x) '节点
  30.         arr(i) = Table.getitemtext(arr(i), "&Hierarchy") '获得内容
  31.     Next x

VBS登入SAP

 VBS登入SAP开发区110

这个能不能成功运行，主要还是靠SendKeys操作键盘，让SAP弹出输入密码的界面，网络延迟，或者SAP Logon不是当时的选择的状态的话都有可能登不上。

  1. Dim wsh
  2. Set wsh = CreateObject("Wscript.shell")
  3. '如果路径中带空格需要用chr(34)&"path"& chr(34)包起来
  4. wsh.Run Chr(34) & "C:\Program Files (x86)\SAP\FrontEnd\SAPgui\saplogon.exe" & Chr(34)
  5.  
  6. wscript.sleep 500
  7. wsh.SendKeys "~"
  8. wscript.sleep 2000
  9.  
  10. If Not IsObject(Application) Then
  11.    Set SapGuiAuto = GetObject("SAPGUI")
  12.    Set Application = SapGuiAuto.GetScriptingEngine
  13. End If
  14. If Not IsObject(Connection) Then
  15.    Set Connection = Application.Children(0)
  16. End If
  17. If Not IsObject(session) Then
  18.    Set session = Connection.Children(0)
  19. End If
  20. If IsObject(wscript) Then
  21.    wscript.ConnectObject session, "on"
  22.    wscript.ConnectObject Application, "on"
  23. End If
  24.  
  25. With session
  26.     .findById("wnd[0]").maximize
  27.     .findById("wnd[0]/usr/txtRSYST-MANDT").Text = "110"
  28.     .findById("wnd[0]/usr/txtRSYST-BNAME").Text = "C10089213"
  29.     .findById("wnd[0]/usr/pwdRSYST-BCODE").Text = "" '密码
  30.     .findById("wnd[0]").sendVKey 0
  31. End With

 实例

函数-提取Tcode 

  1. Function MyGetSAPtCode() As String
  2.     If MyConnectSAP() Then Exit Function
  3.     
  4.     Application.Volatile
  5.     
  6.     MyGetSAPtCode = session.findById("wnd[0]/sbar/pane[1]").Text
  7.     
  8.     Set session = Nothing
  9. End Function

 登入开发区

  1. Sub 登入110()
  2.     Shell "C:\Program Files (x86)\SAP\FrontEnd\SAPgui\saplogon.exe", vbNormalFocus
  3.     Application.Wait (Now() + TimeValue("00:00:02"))
  4.     SendKeys "~"
  5.     Application.Wait (Now() + TimeValue("00:00:04")) '如果系统反应不过来的话后面会赋值不到，有必要的话可以延长时间
  6.  
  7.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object
  8.     Set SapGuiAuto = GetObject("SAPGUI")
  9.     Set AppSap = SapGuiAuto.GetScriptingEngine
  10.     Set Connection = AppSap.Children(0)
  11.     Set session = Connection.Children(0)
  12.  
  13.     With session
  14.         .findById("wnd[0]").maximize
  15.         .findById("wnd[0]/usr/txtRSYST-MANDT").Text = "110"
  16.         .findById("wnd[0]/usr/txtRSYST-BNAME").Text = "C10089213"
  17.         .findById("wnd[0]/usr/pwdRSYST-BCODE").Text = "" '密码
  18.         .findById("wnd[0]").sendVKey 0
  19.     End With
  20. End Sub

CO03

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

  1. Sub CO03_显示_结算规则()
  2.     Dim iMg As VbMsgBoxStyle
  3.     iMg = MsgBox("是否显示CO03？" & Chr(10) & " " & Chr(10), vbYesNo, "CO03")
  4.     If iMg = 7 Then Exit Sub
  5.  
  6.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object
  7.     Set SapGuiAuto = GetObject("SAPGUI")
  8.     Set AppSap = SapGuiAuto.GetScriptingEngine
  9.     Set Connection = AppSap.Children(0)
  10.     Set session = Connection.Children(0)
  11.  
  12.     Dim x As Integer, y As Integer, sr As String, rg As Range, arr1(), i As Integer, bl As Boolean
  13.     Dim Table As Object, Columns As Object
  14.     ReDim arr2(1 To 1000, 1 To 10)
  15.  
  16.     sr = "CO03"
  17.     Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")
  18.     If rg Is Nothing Then
  19.         MsgBox "错误！表【" & sr & "】中无数据！"
  20.         Exit Sub
  21.     End If
  22.     arr1 = rg.CurrentRegion.Value
  23.  
  24.     With session
  25.         For x = 2 To UBound(arr1)
  26.             If arr1(x, 1) = "" Then Exit For
  27.             .findById("wnd[0]").maximize
  28.             .findById("wnd[0]/tbar[0]/okcd").Text = "/NCO03"
  29.             .findById("wnd[0]").sendVKey 0 'Enter
  30.             .findById("wnd[0]/usr/ctxtCAUFVD-AUFNR").Text = arr1(x, 1) '工单
  31.             .findById("wnd[0]").sendVKey 0 '
  32.             arr2(x - 1, 1) = "'" & .findById("wnd[0]/usr/ctxtCAUFVD-WERKS").Text '工厂
  33.             .findById("wnd[0]/usr/tabsTABSTRIP_0115/tabpVERW").Select '管理
  34.             arr2(x - 1, 2) = .findById("wnd[0]/usr/tabsTABSTRIP_0115/tabpVERW/ssubSUBSCR_0115:SAPLCOKO1:0170/txtCAUFVD-ERNAM").Text '创建
  35.             arr2(x - 1, 3) = .findById("wnd[0]/usr/tabsTABSTRIP_0115/tabpVERW/ssubSUBSCR_0115:SAPLCOKO1:0170/txtCAUFVD-AENAM").Text '更改
  36.             .findById("wnd[0]/mbar/menu[4]/menu[3]").Select '结算规则
  37.             arr2(x - 1, 4) = .findById("wnd[0]/usr/tblSAPLKOBSTC_RULES/ctxtCOBRB-KONTY[0,1]").Text 'CTR
  38.             .findById("wnd[0]").sendVKey 2 '进入结算规则里
  39.             arr2(x - 1, 5) = .findById("wnd[0]/usr/subBLOCK1:SAPLKOBS:0200/txtCOBR_INFO-OBJ_TEXT").Text ' 工单说明
  40.             arr2(x - 1, 6) = .findById("wnd[0]/usr/subBLOCK2:SAPLKACB:1014/ctxtCOBL-KOSTL").Text '成本中心
  41.             arr2(x - 1, 7) = .findById("wnd[0]/usr/subBLOCK2:SAPLKACB:1014/ctxtCOBL-PS_POSID").Text 'WBS元素
  42.             arr2(x - 1, 8) = .findById("wnd[0]/usr/subBLOCK2:SAPLKACB:1014/ctxtCOBL-SAKNR").Text '总账科目
  43.             arr2(x - 1, 9) = .findById("wnd[0]/usr/subBLOCK2:SAPLKACB:1014/ctxtCOBL-PRCTR").Text '利润中心
  44.             arr2(x - 1, 10) = .findById("wnd[0]/usr/txtCOBRB-PROZS").Text '百分比
  45.         Next x
  46.     End With
  47.     
  48.     With ThisWorkbook.Sheets("CO03")
  49.         .AutoFilterMode = False
  50.         With .Cells(1, 2)
  51.             .Resize(1, UBound(arr2, 2)).EntireColumn.ClearContents
  52.             .Resize(1, UBound(arr2, 2)) = Split("工厂;创建人;更改人;CTR;工单说明;成本中心;WBS元素;总账科目;利润中心;百分比", ";")
  53.             .Cells(2, 1).Resize(UBound(arr1), UBound(arr2, 2)) = arr2
  54.         End With
  55.     End With
  56. End Sub

MM03

MM03查询标估价等

  1. Sub MM03_显示物料()
  2.     Dim iMg As VbMsgBoxStyle
  3.     iMg = MsgBox("是否显示物料？" & Chr(10) & " " & Chr(10), vbYesNo, "MM03")
  4.     If iMg = 7 Then Exit Sub
  5.  
  6.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object
  7.     Set SapGuiAuto = GetObject("SAPGUI")
  8.     Set AppSap = SapGuiAuto.GetScriptingEngine
  9.     Set Connection = AppSap.Children(0)
  10.     Set session = Connection.Children(0)
  11.  
  12.     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 Boolean
  13.     Dim Table As Object, Columns As Object
  14.     ReDim arr2(1 To 10000, 1 To 20)
  15.  
  16.     sr = "MM03"
  17.     Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")
  18.     If rg Is Nothing Then
  19.         MsgBox "错误！表【" & sr & "】中无数据！"
  20.         Exit Sub
  21.     End If
  22.     arr1 = rg.CurrentRegion.Value
  23.  
  24.     bl = False
  25.     With session
  26.         For x = 2 To UBound(arr1)
  27.             If arr1(x, 1) = "" Then Exit For
  28.             .findById("wnd[0]").maximize
  29.             .findById("wnd[0]/tbar[0]/okcd").Text = "/NMM03"
  30.             .findById("wnd[0]").sendVKey 0 'Enter
  31.             .findById("wnd[0]/usr/ctxtRMMG1-MATNR").Text = arr1(x, 2) '查询物料
  32.             .findById("wnd[0]").sendVKey 0
  33.             i = 0
  34.             j = 0
  35.             Do
  36.                 i = i + 1
  37.                 sr = "wnd[1]/usr/tblSAPLMGMMTC_VIEW/txtMSICHTAUSW-DYTXT[0," & i & "]"
  38.                 If .findById(sr, False) Is Nothing Then
  39.                     bl = True
  40.                     Exit Do
  41.                 Else
  42.                     If .findById(sr).Text = "会计 1" Then
  43.                         .findById("wnd[1]/usr/tblSAPLMGMMTC_VIEW").getAbsoluteRow(j * 16 + i).Selected = True
  44.                         .findById("wnd[1]/tbar[0]/btn[0]").press
  45.                         Exit Do
  46.                     End If
  47.                 End If
  48.                 If i Mod 16 = 0 Then '选择视图最大有16个栏位， 超过要下滑滚动条
  49.                     .findById("wnd[1]/usr/tblSAPLMGMMTC_VIEW").verticalScrollbar.Position = 16
  50.                     i = 0
  51.                     j = j + 1
  52.                 End If
  53.             Loop
  54.            
  55.             If .findById("wnd[0]/sbar/pane[0]").Text <> "" Then '物料查不到下面会有一个警告冒出来
  56.                 bl = True
  57.             Else
  58.                 sr = "wnd[2]/tbar[0]/btn[0]"
  59.                 If Not session.findById(sr, False) Is Nothing Then '测试区没有这个错误提示，正式区有
  60.                     .findById(sr).press '输入工厂前有个错误提示要确定
  61.                 End If
  62.                 .findById("wnd[1]/usr/ctxtRMMG1-WERKS").Text = arr1(x, 1)
  63.                 .findById("wnd[1]/tbar[0]/btn[0]").press
  64.                 If Not .findById("wnd[2]/usr/txtMESSTXT1", False) Is Nothing Then '查不到某个工厂的物料会有个警告
  65.                     bl = True
  66.                 Else
  67.                     arr2(x - 1, 4) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP25/ssubTABFRA1:SAPLMGMM:2000/subSUB2:SAPLMGD1:2800/subSUB1:SAPLCKMMAT:0010/tabsTABS/tabpPPLF").Text '会计期间
  68.                     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 '公司代码货币 标准价格
  69.                     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 '公司代码货币 价格单位
  70.                     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 '集团公司记帐货币，利润中心评估
  71.                     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 '集团公司记帐货币，利润中心评估 价格单位
  72.                     .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28").Select '成本核算2
  73.                     arr2(x - 1, 1) = "'" & .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB1:SAPLMGD1:1009/ctxtRMMG1-WERKS").Text '工厂
  74.                     arr2(x - 1, 2) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB1:SAPLMGD1:1009/ctxtRMMG1-MATNR").Text '物料
  75.                     arr2(x - 1, 3) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB1:SAPLMGD1:1009/txtMAKT-MAKTX").Text '描述
  76.                     arr2(x - 1, 9) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB2:SAPLMGD1:2953/txtMBEW-PDATL").Text '会计年度
  77.                     arr2(x - 1, 10) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB2:SAPLMGD1:2953/txtMBEW-PPRDL").Text '期间
  78.                     arr2(x - 1, 11) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB4:SAPLMGD1:2902/ctxtMBEW-BKLAS").Text '评估类
  79.                     arr2(x - 1, 12) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB4:SAPLMGD1:2902/ctxtMBEW-VPRSV").Text '价格控制
  80.                     arr2(x - 1, 13) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB4:SAPLMGD1:2902/txtMBEW-PEINH").Text '价格单位
  81.                     arr2(x - 1, 14) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB2:SAPLMGD1:2953/txtMBEW-LPLPR").Text '计划价格
  82.                     arr2(x - 1, 15) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB2:SAPLMGD1:2953/txtMBEW-STPRS").Text '标准价格
  83.                     arr2(x - 1, 16) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB3:SAPLMGD1:2952/txtMBEW-ZPLP1").Text '计划价格1
  84.                     arr2(x - 1, 17) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB3:SAPLMGD1:2952/ctxtMBEW-ZPLD1").Text '计划价格日期1
  85.                     arr2(x - 1, 18) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB2:SAPLMGD1:2953/txtMBEW-PPRDZ").Text '将来期间
  86.                     arr2(x - 1, 19) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB2:SAPLMGD1:2953/txtMBEW-PDATZ").Text '将来年份
  87.                     arr2(x - 1, 20) = .findById("wnd[0]/usr/tabsTABSPR1/tabpSP28/ssubTABFRA1:SAPLMGMM:2000/subSUB2:SAPLMGD1:2953/txtMBEW-ZPLPR").Text '将来价格
  88.                 End If
  89.             End If
  90.         Next x
  91.     End With
  93.     With ThisWorkbook.Sheets("MM03")
  94.         .AutoFilterMode = False
  95.         With .Cells(1, 3)
  96.             .Resize(1, UBound(arr2, 2)).EntireColumn.ClearContents
  97.             .Resize(1, UBound(arr2, 2)) = Split("工厂;物料;描述;会计期间;公司标准价;公司价格单位;利润中心标准价;利润中心价格单位;会计年度;期间;评估类;价格控制;价格单位;计划价格;标准价格;计划价格1;计划价格日期1;将来期间;将来年份;将来价格", ";")
  98.             .Cells(2, 1).Resize(UBound(arr1), UBound(arr2, 2)) = arr2
  99.         End With
  100.     End With
  101.     
  102.     If bl Then
  103.         MsgBox "注意！有物料没查到！"
  104.     Else
  105.         MsgBox "成功"
  106.     End If
  107. End Sub

CS15

CS15查询多个料号的BOM

  1. Sub CS15_单层反查清单_多层()
  2.     Dim iMg As VbMsgBoxStyle
  3.     iMg = MsgBox("是否显示 CS15？" & Chr(10) & " " & Chr(10), vbYesNo, "CS15 - 单层反查清单")
  4.     If iMg = 7 Then Exit Sub
  5.  
  6.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object
  7.     Set SapGuiAuto = GetObject("SAPGUI")
  8.     Set AppSap = SapGuiAuto.GetScriptingEngine
  9.     Set Connection = AppSap.Children(0)
  10.     Set session = Connection.Children(0)
  11.  
  12.     Dim x As Integer, y As Integer, z As Integer, sr As String, rg As Range, arr1(), k As Integer, brr(), bl As Boolean
  13.     Dim Table As Object, Columns As Object
  14.     ReDim arr2(1 To 100000, 1 To 15) '此处要提前知道列数，并且加了一列 'Table.ColumnCount()
  15.     ReDim brr(1 To 15)
  16.      
  17.     sr = "CS15"
  18.     Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")
  19.     If rg Is Nothing Then
  20.         MsgBox "错误！表【" & sr & "】中无数据！"
  21.         Exit Sub
  22.     End If
  23.     arr1 = rg.CurrentRegion.Value
  24.     brr(1) = "物料"
  25.     With session
  26.         For z = 2 To UBound(arr1)
  27.             If arr1(z, 1) = "" Then Exit For
  28.             .findById("wnd[0]").maximize
  29.             .findById("wnd[0]/tbar[0]/okcd").Text = "/NCS15"
  30.             .findById("wnd[0]").sendVKey 0 'Enter
  31.             .findById("wnd[0]/usr/ctxtRC29L-DATUV").Text = TheTime(0, "yyyy.mm.dd")
  32.             .findById("wnd[0]/usr/ctxtRC29L-MATNR").Text = arr1(z, 2) '物料
  33.             .findById("wnd[0]/usr/chkRC29L-DIRKT").Selected = True
  34.             .findById("wnd[0]/tbar[1]/btn[5]").press
  35.             .findById("wnd[0]/usr/ctxtRC29L-WERKS").Text = arr1(z, 1) '工厂
  36.             .findById("wnd[0]/usr/chkRC29L-MEHRS").Selected = True '多层
  37.             .findById("wnd[0]/tbar[1]/btn[8]").press
  38.             If .findById("wnd[0]/sbar/pane[0]").Text <> "" Then
  39.                 bl = True
  40.                 k = k + 1
  41.                 arr2(k, 1) = arr1(z, 2)
  42.                 arr2(k, 4) = arr1(z, 1)
  43.                 arr2(k, 5) = .findById("wnd[0]/sbar/pane[0]").Text
  44.             Else
  45.                 Set Table = .findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell")
  46.                 Set Columns = Table.ColumnOrder()
  47.                 For x = 0 To Table.RowCount() - 1
  48.                     k = k + 1
  49.                     arr2(k, 1) = arr1(z, 2)
  50.                     For y = 0 To Table.ColumnCount() - 1
  51.                         arr2(k, y + 2) = Table.getcellvalue(x, CStr(Columns(y)))
  52.                     Next y
  53.                     If x Mod 39 = 0 Then 'bom 测试是每39行后要刷一次屏，否则导出的数据是空白
  54.                         Table.SetCurrentCell x, CStr(Columns(0))
  55.                         Table.firstVisibleRow = x
  56.                     End If
  57.                 Next x
  58.                 For y = 0 To Table.ColumnCount() - 1
  59.                     brr(y + 2) = CStr(Columns(y)) '目前关闭
  60.                 Next y
  61.             End If
  62.         Next z
  63.     End With
  64.     For x = 1 To k
  65.         arr2(x, 4) = "'" & arr2(x, 4)
  66.     Next x
  67.  
  68.     With ThisWorkbook.Sheets("CS15")
  69.         .AutoFilterMode = False
  70.         With .Cells(1, 3)
  71.             .Resize(1, UBound(arr2, 2)).EntireColumn.ClearContents
  72.             .Resize(1, UBound(arr2, 2)) = brr '目前没用
  73.             .Resize(1, UBound(arr2, 2)) = Split("物料;级别;物料清单用途;工厂;对象;对象标识;备选物料清单;项目编号;超出需求数量;需求数量;组件计量单位;ResQ excess;重计划数量;基本计量单位;对象描述", ";")
  74.             If k > 0 Then .Cells(2, 1).Resize(k, UBound(arr2, 2)) = arr2
  75.         End With
  76.     End With
  78.     If bl Then
  79.         MsgBox "注意！有部分没有查到！"
  80.     Else
  81.         MsgBox "成功"
  82.     End If
  83. End Sub

TEST

测试运行，读取Shell

  1. Sub test()
  2.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object
  3.     Set SapGuiAuto = GetObject("SAPGUI")
  4.     Set AppSap = SapGuiAuto.GetScriptingEngine
  5.     Set Connection = AppSap.Children(0)
  6.     Set session = Connection.Children(0)
  7.     
  8.     Dim Table As Object, Columns As Object
  9.     
  10.     Dim x As Integer, y As Integer, k As Integer, arr(), Title()
  11.     ReDim arr(1 To 100000, 1 To 15)
  12.     ReDim Title(1 To 15)
  13.  
  14.     With session
  15.         Set Table = .findById("wnd[0]/usr/cntlFDBL_BALANCE_CONTAINER/shellcont/shell")  '把表shell赋值给Table
  16.         Set Columns = Table.ColumnOrder() '取列
  17.         For x = 0 To Table.RowCount() - 1  'Table.RowCount表示为总行数
  18.             k = k + 1
  19.             For y = 0 To Table.ColumnCount() - 1 'Table.ColumnCount表示总列数Table.ColumnCount
  20.                 arr(k, y + 1) = Table.getcellvalue(x, CStr(Columns(y))) '取值
  21.             Next y
  22.         Next x
  23.         For y = 0 To Table.ColumnCount() - 1
  24.             Title(y + 1) = CStr(Columns(y)) 'Columns返回标题文本
  25.         Next y
  26.     End With
  27.     
  28.     With ThisWorkbook.Sheets("test")
  29.         .AutoFilterMode = False
  30.         .Cells.ClearContents
  31.          .Cells(1, 1).Resize(1, UBound(arr, 2)) = Title
  32.          If k > 0 Then .Cells(2, 1).Resize(k, UBound(arr, 2)) = arr
  33.     End With
  34. End Sub

KS13

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

  1.  
  2. Sub KS13_显示成本中心()
  3.     Dim iMg As VbMsgBoxStyle
  4.     iMg = MsgBox("是否显示成本中心？" & Chr(10) & " " & Chr(10), vbYesNo, "KS13")
  5.     If iMg = 7 Then Exit Sub
  6.  
  7.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object
  8.     Set SapGuiAuto = GetObject("SAPGUI")
  9.     Set AppSap = SapGuiAuto.GetScriptingEngine
  10.     Set Connection = AppSap.Children(0)
  11.     Set session = Connection.Children(0)
  12.  
  13.     Dim x As Long, y As Integer, z As Integer, sr As String, rg As Range, bl As Boolean, wb As Workbook, j As Integer
  14.     Dim arr1(), arr2(), arr3(), k As Long
  15.     ReDim arr3(1 To 100000, 1 To 23)
  16.      
  17.     sr = "KS13"
  18.     Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")
  19.     If rg Is Nothing Then
  20.         MsgBox "错误！表【" & sr & "】中无数据！"
  21.         Exit Sub
  22.     End If
  23.     arr1 = rg.CurrentRegion.Value
  24.  
  25.     Call KillSapPath
  26.  
  27.     With session
  28.         For z = 2 To UBound(arr1)
  29.             If arr1(z, 1) = "" Then Exit For
  30.             .findById("wnd[0]").maximize
  31.             .findById("wnd[0]/tbar[0]/okcd").Text = "/NKS13"
  32.             .findById("wnd[0]").sendVKey 0 'Enter
  33.             .findById("wnd[0]/usr/subKOSTL_SELECTION:SAPLKMS1:0100/radKMAS_D-KZKOSTL").Select
  34.             .findById("wnd[0]/usr/subKOSTL_SELECTION:SAPLKMS1:0100/ctxtKMAS_D-KOSTL").Text = "" '成本中心
  35.             .findById("wnd[0]/usr/subKOSTL_SELECTION:SAPLKMS1:0100/radKMAS_D-KZVARIANT").Select
  36.             .findById("wnd[0]/usr/subKOSTL_SELECTION:SAPLKMS1:0100/ctxtKMAS_D-VARIANT_KS").Text = "" '选择变式
  37.             .findById("wnd[0]/usr/ctxtCSKSZ-DATAB_ANFO").Text = TheTime(0, "yyyy.mm.01")
  38.             .findById("wnd[0]/usr/subKOSTL_SELECTION:SAPLKMS1:0100/radKMAS_D-KZKOSTLSET").Select
  39.             .findById("wnd[0]/usr/subKOSTL_SELECTION:SAPLKMS1:0100/ctxtKMAS_D-KOSTL_SET").Text = arr1(z, 1) '成本中心组
  40.             .findById("wnd[0]/tbar[1]/btn[8]").press '执行
  41.             bl = True
  42.             sr = "wnd[0]/sbar/pane[0]"
  43.             If .findById(sr, False) Is Nothing Then
  44.                 If Right(.findById(sr), 3) <> "不存在" Then
  45.                     bl = False
  46.                 End If
  47.             End If
  48.             If bl Then
  49.                 If Not .findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell", False) Is Nothing Then
  50.                     .findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").contextMenu
  51.                     .findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").selectContextMenuItem "&XXL"
  52.                     .findById("wnd[1]/tbar[0]/btn[0]").press
  53.                     .findById("wnd[1]/usr/ctxtDY_PATH").Text = SapPath()
  54.                     j = j + 1 '每次命名的文件不一致
  55.                     .findById("wnd[1]/usr/ctxtDY_FILENAME").Text = j & ".XLSX"
  56.                     .findById("wnd[1]/tbar[0]/btn[0]").press
  57.                     Set wb = Workbooks.Open(SapPath() & "/" & j & ".XLSX") '对文件取值
  58.                     arr2 = wb.Sheets(1).Range("A1").CurrentRegion.Value
  59.                     wb.Close
  60.                     Set wb = Nothing
  61.                     For x = 2 To UBound(arr2)
  62.                         k = k + 1
  63.                         arr3(k, 1) = arr1(z, 1)
  64.                         For y = 1 To UBound(arr2, 2)
  65.                             arr3(k, y + 1) = arr2(x, y)
  66.                         Next y
  67.                     Next x
  68.                 End If
  69.             End If
  70.         Next z
  71.     End With
  72.  
  73.     With ThisWorkbook.Sheets("KS13")
  74.         .AutoFilterMode = False
  75.         With .Cells(1, 2)
  76.             .Resize(1, UBound(arr3, 2)).EntireColumn.ClearContents
  77.             .Resize(1, UBound(arr3, 2)) = Split("成本中心组;成本中心;部门编码;名称;描述;负责人;部门;利润中心;公司代码;数据线;打印机所在地;货币;CostCtrCat;功能范围;有效期自;有效期至;计划: 次成本(锁标识);计划: 收入(锁标识);计划: 主成本(锁标识);实际: 收入 (锁标识);实际: 主成本(锁标识);实际:次收入 (锁标识);成本核算表", ";")
  78.             If k > 0 Then .Cells(2, 1).Resize(k, UBound(arr3, 2)) = arr3
  79.         End With
  80.     End With
  81.     
  82.     MsgBox "完成！"
  83. End Sub

KSH1

KSH1建立成本中心组

  1. Sub KSH1_创建成本中心组()
  2.     Dim iMg As VbMsgBoxStyle
  3.     iMg = MsgBox("是否创建成本中心组？" & Chr(10) & " " & Chr(10) & "创建之前要自行检查下是否确实需要创建！", vbYesNo, "KSH1")
  4.     If iMg = 7 Then Exit Sub
  5.     
  6.     Dim 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 Integer
  7.  
  8.     sr = "KSH1"
  9.     Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")
  10.     If rg Is Nothing Then
  11.         MsgBox "错误！表【" & sr & "】中无数据！"
  12.         Exit Sub
  13.     End If
  14.     Dim arr()
  15.         arr = rg.CurrentRegion.Value
  16.     Dim dZ As Object
  17.         Set dZ = CreateObject("scripting.dictionary")
  18.         For x = 1 To UBound(arr, 2)
  19.             dZ(arr(1, x)) = x
  20.         Next x
  21.     Dim a As Byte, b As Byte, c As Byte, d As Byte
  22.         a = dZ("成本中心组")
  23.         b = dZ("成本中心组名称")
  24.         c = dZ("成本中心")
  25.         d = dZ("成本中心名称")
  26.  
  27.     Dim dic1 As Object, dic2 As Object
  28.     Set dic1 = CreateObject("scripting.dictionary")
  29.     Set dic2 = CreateObject("scripting.dictionary")
  30.     
  31.     For x = 2 To UBound(arr)
  32.         sr = arr(x, a)
  33.         sg = arr(x, c)
  34.         If Not dic1.exists(sr) Then
  35.             Set dic1(sr) = CreateObject("scripting.dictionary")
  36.         End If
  37.         dic1(sr)(sg) = ""
  38.     Next x
  39.     For x = 2 To UBound(arr)
  40.         sr = arr(x, a)
  41.         sg = arr(x, b)
  42.         dic2(sr) = sg
  43.     Next x
  44.  
  45.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object, Position
  46.     Set SapGuiAuto = GetObject("SAPGUI")
  47.     Set AppSap = SapGuiAuto.GetScriptingEngine
  48.     Set Connection = AppSap.Children(0)
  49.     Set session = Connection.Children(0)
  50.     
  51.     With session
  52.         For Each v In dic1.keys
  53.             .findById("wnd[0]").maximize
  54.             .findById("wnd[0]/tbar[0]/okcd").Text = "/NKSH1"
  55.             .findById("wnd[0]").sendVKey 0 'Enter
  56.             If Not .findById("wnd[1]/usr/sub:SAPLSPO4:0300/ctxtSVALD-VALUE[0,21]", False) Is Nothing Then '检测是否需要输入控制范围
  57.                 .findById("wnd[1]/usr/sub:SAPLSPO4:0300/ctxtSVALD-VALUE[0,21]").Text = 2688
  58.                 .findById("wnd[0]").sendVKey 0
  59.             End If
  60.             .findById("wnd[0]/usr/ctxtGRPDYNP-NAME_COALL").Text = v
  61.             .findById("wnd[0]").sendVKey 0
  62.             If Not .findById("wnd[1]/usr/btnBUTTON_2", False) Is Nothing Then '检测是否被创建
  63.                 .findById("wnd[1]/usr/btnBUTTON_2").press
  64.                 MsgBox "失败！【" & v & "】已经被创建！"
  65.                 Exit Sub
  66.             End If
  67.             .findById("wnd[0]/usr/txt[16,0]").Text = dic2(CStr(v))
  68.             i = 1 '记录屏幕上的输入框行数，跨页要重置
  69.             j = 0 '计算点击“插入成本中心”的次数
  70.             k = 0 '计算“竖向滚动条”下拉的频次
  71.             Do
  72.                 j = j + 1
  73.                 .findById("wnd[0]/tbar[1]/btn[16]").press
  74.             Loop Until j = dic1(CStr(v)).Count \ 5 + 1 '点击“插入成本中心”一次可以填五个成本中心
  75.             For Each u In dic1(CStr(v)).keys
  76.                 i = i + 1
  77.                 .findById("wnd[0]/usr/txt[4," & i & "]").Text = u
  78.                 If i Mod 29 = 0 Then '测试DELL电脑最大显示的成本中心个数，到46时 i 会报错，要填45；测试华硕电脑是要写29
  79.                     k = k + 1
  80.                     .findById("wnd[0]/usr").verticalScrollbar.Position = i * k
  81.                     i = 0
  82.                 End If
  83.             Next u
  84.             .findById("wnd[0]/tbar[0]/btn[11]").press '保存（慎用）
  85.         Next v
  86.     End With
  87.     
  88.     MsgBox "成功！"
  89. End Sub

KSH2

KSH2修改成本中心组

  1. Sub KSH2_标题()
  2.     Dim arr() As String
  3.     arr = Split("成本中心组;成本中心组名称;成本中心;成本中心名称", ";")
  4.     
  5.     With ThisWorkbook.Sheets("KSH2")
  6.         .AutoFilterMode = False
  7.         .Cells(1, 1).Resize(1, UBound(arr) + 1) = arr
  8.     End With
  9. End Sub
  10.  
  11.  
  12.  
  13. Sub KSH2_修改成本中心组_重置() '会修改成本中心组名称
  14.     Dim iMg As VbMsgBoxStyle
  15.     iMg = MsgBox("是否修改成本中心组？" & Chr(10) & " " & Chr(10) & "修改之前要检查成本中心组是否已经创建，否则会出现修改一半进行不下去的情况！", vbYesNo, "KSH2")
  16.     If iMg = 7 Then Exit Sub
  17.     
  18.     Dim 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 Integer
  19.  
  20.     sr = "KSH2"
  21.     Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")
  22.     If rg Is Nothing Then
  23.         MsgBox "错误！表【" & sr & "】中无数据！"
  24.         Exit Sub
  25.     End If
  26.     Dim arr()
  27.         arr = rg.CurrentRegion.Value
  28.     Dim dZ As Object
  29.         Set dZ = CreateObject("scripting.dictionary")
  30.         For x = 1 To UBound(arr, 2)
  31.             dZ(arr(1, x)) = x
  32.         Next x
  33.     Dim a As Byte, b As Byte, c As Byte, d As Byte
  34.         a = dZ("成本中心组")
  35.         b = dZ("成本中心组名称")
  36.         c = dZ("成本中心")
  37.         d = dZ("成本中心名称")
  38.  
  39.     Dim dic1 As Object, dic2 As Object
  40.     Set dic1 = CreateObject("scripting.dictionary")
  41.     Set dic2 = CreateObject("scripting.dictionary")
  42.     
  43.     For x = 2 To UBound(arr)
  44.         sr = arr(x, a)
  45.         sg = arr(x, c)
  46.         If Not dic1.exists(sr) Then
  47.             Set dic1(sr) = CreateObject("scripting.dictionary")
  48.         End If
  49.         dic1(sr)(sg) = ""
  50.     Next x
  51.     For x = 2 To UBound(arr)
  52.         sr = arr(x, a)
  53.         sg = arr(x, b)
  54.         dic2(sr) = sg
  55.     Next x
  56.  
  57.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object, Position
  58.     Set SapGuiAuto = GetObject("SAPGUI")
  59.     Set AppSap = SapGuiAuto.GetScriptingEngine
  60.     Set Connection = AppSap.Children(0)
  61.     Set session = Connection.Children(0)
  62.     
  63.     With session
  64.         For Each v In dic1.keys
  65.             .findById("wnd[0]").maximize
  66.             .findById("wnd[0]/tbar[0]/okcd").Text = "/NKSH2"
  67.             .findById("wnd[0]").sendVKey 0 'Enter
  68.             If Not .findById("wnd[1]/usr/sub:SAPLSPO4:0300/ctxtSVALD-VALUE[0,21]", False) Is Nothing Then '检测是否需要输入控制范围
  69.                 .findById("wnd[1]/usr/sub:SAPLSPO4:0300/ctxtSVALD-VALUE[0,21]").Text = 2688
  70.                 .findById("wnd[0]").sendVKey 0
  71.             End If
  72.             .findById("wnd[0]/usr/ctxtGRPDYNP-NAME_COALL").Text = v
  73.             .findById("wnd[0]").sendVKey 0
  74.             If Not .findById("wnd[1]/usr/btnBUTTON_2", False) Is Nothing Then '检测是否有成本中心组
  75.                 .findById("wnd[1]/usr/btnBUTTON_2").press
  76.                 MsgBox "失败！【" & v & "】还没创建！"
  77.                 Exit Sub
  78.             End If
  79.             .findById("wnd[0]/usr/txt[16,0]").Text = dic2(CStr(v))
  80.             Do '删除组下面所有的成本中心
  81.                 If .findById("wnd[0]/usr/lbl[4,2]", False) Is Nothing Then Exit Do
  82.                 .findById("wnd[0]/usr/lbl[4,2]").SetFocus
  83.                 .findById("wnd[0]/tbar[1]/btn[9]").press
  84.                 .findById("wnd[0]/tbar[1]/btn[5]").press
  85.             Loop
  86.  
  87.             i = 1 '记录屏幕上的输入框行数，跨页要重置
  88.             j = 0 '计算点击“插入成本中心”的次数
  89.             k = 0 '计算“竖向滚动条”下拉的频次
  90.             Do
  91.                 j = j + 1
  92.                 .findById("wnd[0]/tbar[1]/btn[16]").press
  93.             Loop Until j = dic1(CStr(v)).Count \ 5 + 1 '点击“插入成本中心”一次可以填五个成本中心
  94.             For Each u In dic1(CStr(v)).keys
  95.                 i = i + 1
  96.                 .findById("wnd[0]/usr/txt[4," & i & "]").Text = u
  97.                 If i Mod 29 = 0 Then '测试DELL电脑最大显示的成本中心个数，到46时 i 会报错，要填45；测试华硕电脑是要写29
  98.                     k = k + 1
  99.                     .findById("wnd[0]/usr").verticalScrollbar.Position = i * k
  100.                     i = 0
  101.                 End If
  102.             Next u
  103.             .findById("wnd[0]/tbar[0]/btn[11]").press '保存（慎用）
  104.         Next v
  105.     End With
  106.     
  107.     MsgBox "成功！"
  108. End Sub
  109.  
  110.  
  111.  
  112.  
  113. Sub KSH2_修改成本中心组_新增()  '不会改成本中心组名称
  114.     Dim iMg As VbMsgBoxStyle
  115.     iMg = MsgBox("是否修改成本中心组？" & Chr(10) & " " & Chr(10) & "修改之前要检查成本中心组是否已经创建，否则会出现修改一半进行不下去的情况！", vbYesNo, "KSH2")
  116.     If iMg = 7 Then Exit Sub
  117.     
  118.     Dim 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 Integer
  119.  
  120.     sr = "KSH2"
  121.     Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")
  122.     If rg Is Nothing Then
  123.         MsgBox "错误！表【" & sr & "】中无数据！"
  124.         Exit Sub
  125.     End If
  126.     Dim arr()
  127.         arr = rg.CurrentRegion.Value
  128.     Dim dZ As Object
  129.         Set dZ = CreateObject("scripting.dictionary")
  130.         For x = 1 To UBound(arr, 2)
  131.             dZ(arr(1, x)) = x
  132.         Next x
  133.     Dim a As Byte, b As Byte, c As Byte, d As Byte
  134.         a = dZ("成本中心组")
  135.         b = dZ("成本中心组名称")
  136.         c = dZ("成本中心")
  137.         d = dZ("成本中心名称")
  138.  
  139.     Dim dic1 As Object
  140.     Set dic1 = CreateObject("scripting.dictionary")
  141.     
  142.     For x = 2 To UBound(arr)
  143.         sr = arr(x, a)
  144.         sg = arr(x, c)
  145.         If Not dic1.exists(sr) Then
  146.             Set dic1(sr) = CreateObject("scripting.dictionary")
  147.         End If
  148.         dic1(sr)(sg) = ""
  149.     Next x
  150.  
  151.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object, Position
  152.     Set SapGuiAuto = GetObject("SAPGUI")
  153.     Set AppSap = SapGuiAuto.GetScriptingEngine
  154.     Set Connection = AppSap.Children(0)
  155.     Set session = Connection.Children(0)
  156.     
  157.     With session
  158.         For Each v In dic1.keys
  159.             .findById("wnd[0]").maximize
  160.             .findById("wnd[0]/tbar[0]/okcd").Text = "/NKSH2"
  161.             .findById("wnd[0]").sendVKey 0 'Enter
  162.             If Not .findById("wnd[1]/usr/sub:SAPLSPO4:0300/ctxtSVALD-VALUE[0,21]", False) Is Nothing Then '检测是否需要输入控制范围
  163.                 .findById("wnd[1]/usr/sub:SAPLSPO4:0300/ctxtSVALD-VALUE[0,21]").Text = 2688
  164.                 .findById("wnd[0]").sendVKey 0
  165.             End If
  166.             .findById("wnd[0]/usr/ctxtGRPDYNP-NAME_COALL").Text = v
  167.             .findById("wnd[0]").sendVKey 0
  168.             If Not .findById("wnd[1]/usr/btnBUTTON_2", False) Is Nothing Then '检测是否有成本中心组
  169.                 .findById("wnd[1]/usr/btnBUTTON_2").press
  170.                 MsgBox "失败！【" & v & "】还没创建！"
  171.                 Exit Sub
  172.             End If
  173.  
  174.             i = 1 '记录屏幕上的输入框行数，跨页要重置
  175.             j = 0 '计算点击“插入成本中心”的次数
  176.             k = 0 '计算“竖向滚动条”下拉的频次
  177.             Do
  178.                 j = j + 1
  179.                 .findById("wnd[0]/tbar[1]/btn[16]").press
  180.             Loop Until j = dic1(CStr(v)).Count \ 5 + 1 '点击“插入成本中心”一次可以填五个成本中心
  181.             For Each u In dic1(CStr(v)).keys
  182.                 i = i + 1
  183.                 .findById("wnd[0]/usr/txt[4," & i & "]").Text = u
  184.                 If i Mod 29 = 0 Then '测试DELL电脑最大显示的成本中心个数，到46时 i 会报错，要填45；测试华硕电脑是要写29
  185.                     k = k + 1
  186.                     .findById("wnd[0]/usr").verticalScrollbar.Position = i * k
  187.                     i = 0
  188.                 End If
  189.             Next u
  190.             .findById("wnd[0]/tbar[0]/btn[11]").press '保存（慎用）
  191.         Next v
  192.     End With
  193.     
  194.     MsgBox "成功！"
  195. End Sub
  196.  
  197.  
  198.  
  199. Sub KSH2_修改成本中心组_删除() '不会改成本中心组名称
  200.     Dim iMg As VbMsgBoxStyle
  201.     iMg = MsgBox("是否修改成本中心组？" & Chr(10) & " " & Chr(10) & "修改之前要检查成本中心组是否已经创建，否则会出现修改一半进行不下去的情况！", vbYesNo, "KSH2")
  202.     If iMg = 7 Then Exit Sub
  203.     
  204.     Dim 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 Integer
  205.  
  206.     sr = "KSH2"
  207.     Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")
  208.     If rg Is Nothing Then
  209.         MsgBox "错误！表【" & sr & "】中无数据！"
  210.         Exit Sub
  211.     End If
  212.     Dim arr()
  213.         arr = rg.CurrentRegion.Value
  214.     Dim dZ As Object
  215.         Set dZ = CreateObject("scripting.dictionary")
  216.         For x = 1 To UBound(arr, 2)
  217.             dZ(arr(1, x)) = x
  218.         Next x
  219.     Dim a As Byte, b As Byte, c As Byte, d As Byte
  220.         a = dZ("成本中心组")
  221.         b = dZ("成本中心组名称")
  222.         c = dZ("成本中心")
  223.         d = dZ("成本中心名称")
  224.  
  225.     Dim dic1 As Object
  226.     Set dic1 = CreateObject("scripting.dictionary")
  227.    
  228.     For x = 2 To UBound(arr)
  229.         sr = arr(x, a)
  230.         sg = arr(x, c)
  231.         If Not dic1.exists(sr) Then
  232.             Set dic1(sr) = CreateObject("scripting.dictionary")
  233.         End If
  234.         dic1(sr)(sg) = ""
  235.     Next x
  236.  
  237.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object, Position
  238.     Set SapGuiAuto = GetObject("SAPGUI")
  239.     Set AppSap = SapGuiAuto.GetScriptingEngine
  240.     Set Connection = AppSap.Children(0)
  241.     Set session = Connection.Children(0)
  242.     
  243.     With session
  244.         For Each v In dic1.keys
  245.             .findById("wnd[0]").maximize
  246.             .findById("wnd[0]/tbar[0]/okcd").Text = "/NKSH2"
  247.             .findById("wnd[0]").sendVKey 0 'Enter
  248.             If Not .findById("wnd[1]/usr/sub:SAPLSPO4:0300/ctxtSVALD-VALUE[0,21]", False) Is Nothing Then '检测是否需要输入控制范围
  249.                 .findById("wnd[1]/usr/sub:SAPLSPO4:0300/ctxtSVALD-VALUE[0,21]").Text = 2688
  250.                 .findById("wnd[0]").sendVKey 0
  251.             End If
  252.             .findById("wnd[0]/usr/ctxtGRPDYNP-NAME_COALL").Text = v
  253.             .findById("wnd[0]").sendVKey 0
  254.             If Not .findById("wnd[1]/usr/btnBUTTON_2", False) Is Nothing Then '检测是否有成本中心组
  255.                 .findById("wnd[1]/usr/btnBUTTON_2").press
  256.                 MsgBox "失败！【" & v & "】还没创建！"
  257.                 Exit Sub
  258.             End If
  259.             i = 1 '记录屏幕上的输入框行数，跨页要重置
  260.             j = 0 '计算点击“插入成本中心”的次数
  261.             Do
  262.                 i = i + 1
  263.                 If .findById("wnd[0]/usr/lbl[4," & i & "]", False) Is Nothing Then Exit Do '没有查到的就退出
  264.                 If .findById("wnd[0]/usr/lbl[15," & i & "]", False) Is Nothing Then Exit Do '没有查到的就退出
  265.                 sr = .findById("wnd[0]/usr/lbl[4," & i & "]").Text
  266.                 If dic1(CStr(v)).exists(sr) Then
  267.                     .findById("wnd[0]/usr/lbl[4," & i & "]").SetFocus
  268.                     .findById("wnd[0]/tbar[1]/btn[9]").press
  269.                     .findById("wnd[0]/tbar[1]/btn[5]").press
  270.                     i = i - 1
  271.                 End If
  272.                 If i Mod 29 = 0 Then '测试DELL电脑最大显示的成本中心个数，到46时 i 会报错，要填45；测试华硕电脑是要写29
  273.                     j = j + 1
  274.                     .findById("wnd[0]/usr").verticalScrollbar.Position = i * j
  275.                     i = 0
  276.                 End If
  277.             Loop
  278.             .findById("wnd[0]/tbar[0]/btn[11]").press '保存（慎用）
  279.         Next v
  280.     End With
  281.     
  282.     MsgBox "成功！"
  283. End Sub

KSH3

KSH3显示成本中心组

  1. Sub KSH3_显示成本中心组()
  2.     Dim iMg As VbMsgBoxStyle
  3.     iMg = MsgBox("是否显示成本中心组？" & Chr(10) & " " & Chr(10), vbYesNo, "KSH3")
  4.     If iMg = 7 Then Exit Sub
  5.  
  6.     Dim x As Integer, sr As String, rg As Range, arr1(), arr2(), brr(), k As Integer, i As Integer, j As Integer, bl As Boolean
  7.     ReDim arr2(1 To 100000, 1 To 5)
  8.     ReDim brr(1 To 2)
  9.  
  10.     sr = "KSH3"
  11.     Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")
  12.     If rg Is Nothing Then
  13.         MsgBox "错误！表【" & sr & "】中无数据！"
  14.         Exit Sub
  15.     End If
  16.     arr1 = rg.CurrentRegion.Value
  17.  
  18.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object, Position
  19.     Set SapGuiAuto = GetObject("SAPGUI")
  20.     Set AppSap = SapGuiAuto.GetScriptingEngine
  21.     Set Connection = AppSap.Children(0)
  22.     Set session = Connection.Children(0)
  23.     
  24.     bl = False
  25.     With session
  26.         For x = 2 To UBound(arr1)
  27.             If arr1(x, 1) <> "" Then
  28.                 .findById("wnd[0]").maximize
  29.                 .findById("wnd[0]/tbar[0]/okcd").Text = "/NKSH3" '显示成本中心组
  30.                 .findById("wnd[0]").sendVKey 0 'Enter
  31.                 If Not .findById("wnd[1]/usr/sub:SAPLSPO4:0300/ctxtSVALD-VALUE[0,21]", False) Is Nothing Then '检测是否需要输入控制范围
  32.                     .findById("wnd[1]/usr/sub:SAPLSPO4:0300/ctxtSVALD-VALUE[0,21]").Text = 2688
  33.                     .findById("wnd[0]").sendVKey 0
  34.                 End If
  35.                 .findById("wnd[0]/usr/ctxtGRPDYNP-NAME_COALL").Text = arr1(x, 1) '查询成本中心组
  36.                 .findById("wnd[0]").sendVKey 0 'Enter
  37.                 If Not .findById("wnd[1]/usr/btnBUTTON_2", False) Is Nothing Then '检测是否有成本中心组
  38.                     .findById("wnd[1]/usr/btnBUTTON_2").press
  39.                     bl = True
  40.                 Else
  41.                     brr(1) = .findById("wnd[0]/usr/lbl[0,0]").Text   '成本中心组名称
  42.                     brr(2) = .findById("wnd[0]/usr/lbl[16,0]").Text '成本中心组描述
  43.                     i = 1 '记录屏幕上的输入框行数，跨页要重置
  44.                     j = 0 '计算点击“插入成本中心”的次数
  45.                     Do
  46.                         i = i + 1
  47.                         If .findById("wnd[0]/usr/lbl[4," & i & "]", False) Is Nothing Then Exit Do '没有查到的就退出
  48.                         If .findById("wnd[0]/usr/lbl[15," & i & "]", False) Is Nothing Then Exit Do '没有查到的就退出
  49.                         k = k + 1
  50.                         arr2(k, 1) = brr(1)
  51.                         arr2(k, 2) = brr(2)
  52.                         arr2(k, 3) = .findById("wnd[0]/usr/lbl[4," & i & "]").Text
  53.                         arr2(k, 4) = .findById("wnd[0]/usr/lbl[15," & i & "]").Text
  54.                         If i Mod 29 = 0 Then '测试DELL电脑最大显示的成本中心个数，到46时 i 会报错，要填45；测试华硕电脑是要写29
  55.                             j = j + 1
  56.                             .findById("wnd[0]/usr").verticalScrollbar.Position = i * j
  57.                             i = 0
  58.                         End If
  59.                     Loop
  60.                 End If
  61.             End If
  62.         Next x
  63.         For x = 1 To k
  64.             If IsNumeric(Right(arr2(x, 3), 1)) Then
  65.                 arr2(x, 5) = False
  66.             Else
  67.                 arr2(x, 5) = True
  68.             End If
  69.         Next x
  70.     End With
  71.     
  72.     With ThisWorkbook.Sheets("KSH3")
  73.         .AutoFilterMode = False
  74.         With .Cells(1, 2)
  75.         .Resize(1, UBound(arr2, 2)).EntireColumn.ClearContents
  76.         .Resize(1, UBound(arr2, 2)) = Split("成本中心组;成本中心组名称;成本中心;成本中心名称;虚拟否", ";")
  77.         If k > 0 Then .Cells(2, 1).Resize(k, UBound(arr2, 2)) = arr2
  78.         End With
  79.     End With
  80.     
  81.     If bl Then
  82.         MsgBox "有成本中心组未查到！"
  83.     Else
  84.         MsgBox "成功！"
  85.     End If
  86. End Sub

FS00

  1. Sub FS00_整理()
  2.     Dim iMg As VbMsgBoxStyle
  3.     iMg = MsgBox("FS00获取科目！" & Chr(10) & " " & Chr(10), vbYesNo, "FSOO")
  4.     If iMg = 7 Then Exit Sub
  5.     
  6.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object
  7.     Set SapGuiAuto = GetObject("SAPGUI")
  8.     Set AppSap = SapGuiAuto.GetScriptingEngine
  9.     Set Connection = AppSap.Children(0)
  10.     Set session = Connection.Children(0)
  11.  
  12.     Dim Table As Object, GetNodeK As Object, arr(), i As Integer, x
  13.    
  14.     '进入程式获取节点
  15.     With session
  16.         .findById("wnd[0]").maximize
  17.         .findById("wnd[0]/tbar[0]/okcd").Text = "/NFS00"
  18.         .findById("wnd[0]").sendVKey 0 'Enter
  19.         Set Table = .findById("wnd[0]/shellcont/shell/shellcont[1]/shell[1]")
  20.         Set GetNodeK = Table.GetAllNodeKeys '得到所有的节点
  21.     End With
  22.     
  23.     '打开所有节点
  24.     For x = GetNodeK.Count - 1 To 0 Step -1
  25.         Table.expandNode GetNodeK.Item(x)
  26.     Next x
  27.  
  28.     '重新读取shell[1]
  29.     Set Table = session.findById("wnd[0]/shellcont/shell/shellcont[1]/shell[1]")
  30.     Set GetNodeK = Table.GetAllNodeKeys '得到所有的节点
  31.     For x = 0 To GetNodeK.Count - 1
  32.         i = i + 1
  33.         ReDim Preserve arr(1 To i)
  34.         arr(i) = GetNodeK.Item(x) '节点
  35.         arr(i) = Table.getitemtext(arr(i), "&Hierarchy") '获得内容
  36.     Next x
  37.  
  38.     'With ThisWorkbook.Sheets("FS00")
  39.     '    .AutoFilterMode = False
  40.     '    .UsedRange.ClearContents
  41.     '    .Cells(1, 1).Resize(i) = Application.Transpose(arr)
  42.     'End With
  43.  
  44.     Dim brr(), v, j As Integer, sr As String
  45.  
  46.     ReDim brr(1 To i, 1 To 4)
  47.     For x = 1 To i
  48.         If InStr(1, arr(x), "  ") = 0 Then
  49.             sr = arr(x)
  50.         Else
  51.             j = j + 1
  52.             brr(j, 1) = sr
  53.             brr(j, 2) = arr(x)
  54.             brr(j, 3) = Split(arr(x), "  ")(0)
  55.             brr(j, 4) = Trim(Replace(arr(x), brr(j, 3), ""))
  56.         End If
  57.     Next x
  58.  
  59.     With ThisWorkbook.Sheets("FS00")
  60.         .AutoFilterMode = False
  61.         .UsedRange.ClearContents
  62.         .Cells(1, 1).Resize(1, UBound(brr, 2)) = Split("科目组;科目与科目描述;科目;科目描述", ";")
  63.         If j > 0 Then .Cells(2, 1).Resize(j, UBound(brr, 2)) = brr
  64.     End With
  65. End Sub

SM30

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

  1. Sub SM30_ZTCO0011B_显示()
  2.     Dim iMg As VbMsgBoxStyle
  3.     iMg = MsgBox("是否显示ZTCO0011B？" & Chr(10) & " " & Chr(10), vbYesNo, "SM30")
  4.     If iMg = 7 Then Exit Sub
  5.  
  6.     Dim x As Integer, y As Integer, sr As String, rg As Range, arr(), k As Integer, i As Integer, j As Integer, bl As Boolean
  7.  
  8.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object, Position
  9.     Set SapGuiAuto = GetObject("SAPGUI")
  10.     Set AppSap = SapGuiAuto.GetScriptingEngine
  11.     Set Connection = AppSap.Children(0)
  12.     Set session = Connection.Children(0)
  13.     
  14.     With session
  15.         .findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B").verticalScrollbar.Position = 0
  16.         sr = .findById("wnd[0]/usr/txtVIM_POSITION_INFO").Text
  17.         j = CDbl(Split(sr, "/")(1))
  18.         ReDim arr(0 To j, 1 To 6)
  19.         i = -1
  20.         For x = 0 To j
  21.             i = i + 1
  22.             arr(x, 1) = .findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B/txtZTCO0011B-BIZCODE[0," & i & "]").Text
  23.             arr(x, 2) = .findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B/txtZTCO0011B-BWART[1," & i & "]").Text
  24.             arr(x, 3) = .findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B/txtZTCO0011B-BIZTEXT[2," & i & "]").Text
  25.             arr(x, 4) = .findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B/cmbZTCO0011B-BIZATTR[3," & i & "]").Text
  26.             arr(x, 5) = .findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B/cmbZTCO0011B-SHKZG[4," & i & "]").Text
  27.             arr(x, 6) = .findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B/txtZTCO0011B-SOBKZ[5," & i & "]").Text
  28.             If i Mod 19 = 0 Then
  29.                 .findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B").verticalScrollbar.Position = x
  30.                 i = 0
  31.             End If
  32.         Next x
  33.     End With
  34.  
  35.     With ThisWorkbook.Sheets("SM30_ZTCO0011B")
  36.         .AutoFilterMode = False
  37.         .Cells.ClearContents
  38.         .Cells(1, 1).Resize(1, UBound(arr, 2)) = Split("业务分类代码;MvT;业务分类描述;业务属性;借贷;特殊库存", ";")
  39.         .Cells(2, 1).Resize(UBound(arr), UBound(arr, 2)) = arr
  40.     End With
  41. End Sub
  42.  
  43.  
  44.  
  45. Sub SM30_ZTCO0011B_导入()
  46.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object, Position
  47.     Set SapGuiAuto = GetObject("SAPGUI")
  48.     Set AppSap = SapGuiAuto.GetScriptingEngine
  49.     Set Connection = AppSap.Children(0)
  50.     Set session = Connection.Children(0)
  51.     
  52.     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 Integer
  53.     Set d = CreateObject("scripting.dictionary")
  54.  
  55.     sr = "SM30_ZTCO0011B"
  56.     Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")
  57.     If rg Is Nothing Then
  58.         MsgBox "错误！表【" & sr & "】中无数据！"
  59.         Exit Sub
  60.     End If
  61.     Dim arr()
  62.         arr = rg.CurrentRegion.Value
  63.  
  64.     d.Add "出库", "2"
  65.     d.Add "入库", "1"
  66.     d.Add "借方", "S"
  67.     d.Add "贷方", "H"
  68.     
  69.     With session
  70.         i = -1
  71.         For x = 2 To UBound(arr)
  72.             i = i + 1
  73.             .findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B/txtZTCO0011B-BIZCODE[0," & i & "]").Text = arr(x, 1)
  74.             .findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B/txtZTCO0011B-BWART[1," & i & "]").Text = arr(x, 2)
  75.             .findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B/txtZTCO0011B-BIZTEXT[2," & i & "]").Text = arr(x, 3)
  76.             If arr(x, 4) <> "" Then .findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B/cmbZTCO0011B-BIZATTR[3," & i & "]").Key = d(arr(x, 4))
  77.             If arr(x, 5) <> "" Then .findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B/cmbZTCO0011B-SHKZG[4," & i & "]").Key = d(arr(x, 5))
  78.             .findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B/txtZTCO0011B-SOBKZ[5," & i & "]").Text = arr(x, 6)
  79.             If i Mod 19 = 0 Then
  80.                 .findById("wnd[0]/usr/tblSAPLZFG_ZTCO0011BTCTRL_ZTCO0011B").verticalScrollbar.Position = x - 2
  81.                 i = 0
  82.             End If
  83.         Next x
  84.     End With
  85. End Sub

Tcode

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

节点文件夹事物码事物文本
F00289PS_1.3_项目预算增加删减流程CJ37项目中的预算补充
F00289PS_1.3_项目预算增加删减流程CJ38项目中的预算返回
F00289PS_1.3_项目预算增加删减流程CJ32改变工程发放
F00289PS_1.3_项目预算增加删减流程CJ33显示项目发行
F00289PS_1.3_项目预算增加删减流程CJ3A改变预算凭证
F00289PS_1.3_项目预算增加删减流程CJ3B显示预算文档
F00289PS_1.2_项目预算编列流程CJ30改变工程项目源预算 
F00289PS_1.2_项目预算编列流程CJ31显示工程项目源预算 
F00289PS_1.2_项目预算编列流程CJ32改变工程发放
F00289PS_1.2_项目预算编列流程CJ33显示项目发行
F00289PS_1.2_项目预算编列流程CJ3A改变预算凭证
F00289PS_1.2_项目预算编列流程CJ3B显示预算文档
F00289PS_1.1_WBS主数据维护流程CJ01生成工作细分结构
F00289PS_1.1_WBS主数据维护流程CJ02更改工作细分结构
F00289PS_1.1_WBS主数据维护流程CJ03显示工作细分结构
F00289PS_1.1_WBS主数据维护流程CJ20N项目构建器 
  1. Sub Tcode_获取节点()
  2.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object
  3.     Set SapGuiAuto = GetObject("SAPGUI")
  4.     Set AppSap = SapGuiAuto.GetScriptingEngine
  5.     Set Connection = AppSap.Children(0)
  6.     Set session = Connection.Children(0)
  7.  
  8.     Dim Table As Object, GetNodeK As Object, arr(), i As Integer, x As Integer, sr As String
  9.     ReDim Title(1 To 10)
  10.    
  11.     '进入程式获取节点
  12.     With session
  13.         .findById("wnd[0]").maximize
  14.         .findById("wnd[0]/tbar[0]/okcd").Text = "/N"
  15.         .findById("wnd[0]").sendVKey 0 'Enter
  16.         sr = "wnd[0]/usr/btnSTARTBUTTON"
  17.         If Not session.findById(sr, False) Is Nothing Then
  18.             .findById(sr).press
  19.         End If
  20.         Set Table = .findById("wnd[0]/usr/cntlIMAGE_CONTAINER/shellcont/shell/shellcont[0]/shell")
  21.         Set GetNodeK = Table.GetAllNodeKeys '得到所有的节点
  22.     End With
  23.  
  24.     For x = 0 To GetNodeK.Count - 1
  25.         i = i + 1
  26.         ReDim Preserve arr(1 To i)
  27.         arr(i) = GetNodeK.Item(x) '节点
  28.     Next x
  29.  
  30.     With ThisWorkbook.Sheets("获取节点")
  31.         .AutoFilterMode = False
  32.         .UsedRange.ClearContents
  33.         .Cells(1, 1).Resize(i) = Application.Transpose(arr)
  34.     End With
  35. End Sub
  36.  
  37.  
  38. Sub Tcode_插入事物码()
  39.     Dim iMg As VbMsgBoxStyle
  40.     iMg = MsgBox("插入事务码！" & Chr(10) & " " & Chr(10), vbYesNo, "SAP_快速插入事务码")
  41.     If iMg = 7 Then Exit Sub
  42.     
  43.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object
  44.     Set SapGuiAuto = GetObject("SAPGUI")
  45.     Set AppSap = SapGuiAuto.GetScriptingEngine
  46.     Set Connection = AppSap.Children(0)
  47.     Set session = Connection.Children(0)
  48.  
  49.     Dim d As Object, x As Integer, rg As Range, k As Integer, s1 As String, s2 As String, v1, v2, v3
  50.     Set d = CreateObject("scripting.dictionary")
  51.     
  52.     Dim Table As Object
  53.  
  54.     s1 = "插入事务码"
  55.     Set rg = ThisWorkbook.Sheets(s1).UsedRange.Find("*")
  56.     If rg Is Nothing Then
  57.         MsgBox "错误！表【" & s1 & "】中无数据！"
  58.         Exit Sub
  59.     End If
  60.     Dim arr()
  61.         arr = rg.CurrentRegion.Value
  62.  
  63.     For x = 2 To UBound(arr)
  64.         s1 = arr(x, 1) '节点
  65.         s2 = arr(x, 2) '文件夹名称
  66.         If Not d.exists(s1) Then
  67.             Set d(s1) = CreateObject("scripting.dictionary")
  68.         End If
  69.         If Not d(s1).exists(s2) Then
  70.             Set d(s1)(s2) = CreateObject("scripting.dictionary")
  71.         End If
  72.         d(s1)(s2)(arr(x, 3)) = "" 'arr(x, 3) 是事务码
  73.     Next x
  74.  
  75.     With session
  76.         .findById("wnd[0]").maximize
  77.         Set Table = .findById("wnd[0]/usr/cntlIMAGE_CONTAINER/shellcont/shell/shellcont[0]/shell")
  78.         For Each v1 In d.keys
  79.             For Each v2 In d(v1).keys
  80.                 Table.selectedNode = v1
  81.                 Table.nodeContextMenu v1
  82.                 Table.selectContextMenuItem "XXFOLD" '插入文件夹
  83.                 .findById("wnd[1]/usr/sub:SAPLSPO4:0300/txtSVALD-VALUE[0,21]").Text = v2
  84.                 .findById("wnd[1]/tbar[0]/btn[0]").press
  85.                 For Each v3 In d(v1)(v2).keys
  86.                     .findById("wnd[0]").maximize
  87.                     Table.nodeContextMenu NodeKeys(CStr(v1))
  88.                     Table.selectContextMenuItem "XXADTC" '插入事务码
  89.                     .findById("wnd[1]/usr/sub:SAPLSPO4:0300/txtSVALD-VALUE[0,21]").Text = v3
  90.                     .findById("wnd[1]/tbar[0]/btn[0]").press
  91.                 Next v3
  92.             Next v2
  93.         Next v1
  94.     End With
  95.     Set d = Nothing
  96.     
  97.     MsgBox "结束！"
  98. End Sub
  99.  
  100.  
  101. Function NodeKeys(s1 As String) As String '例如 要把 F00289 改成 F00290
  102.     Dim i As Integer, s2 As String
  103.     
  104.     i = Len(s1)
  105.     s2 = CDbl(Right(s1, i - 1)) + 1
  106.     NodeKeys = "F" & Application.Rept(0, i - Len(s2) - 1) & s2
  107. End Function

CKM3N

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

CKM3N维护查询的数据
年月工厂料号
202340510G1CMX085065A-Y
  1. Sub CKM3N_显示物料价格_跨月_多料号()
  2.     On Error Resume Next
  3.  
  4.     Dim iMg As VbMsgBoxStyle
  5.     iMg = MsgBox("是否在正式区显示物料价格？" & Chr(10) & " " & Chr(10), vbYesNo, "CKM3N")
  6.     If iMg = 7 Then Exit Sub
  7.  
  8.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object
  9.     Set SapGuiAuto = GetObject("SAPGUI")
  10.     Set AppSap = SapGuiAuto.GetScriptingEngine
  11.     Set Connection = AppSap.Children(0)
  12.     Set session = Connection.Children(0)
  13.  
  14.     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, v
  15.     Dim Table As Object, Columns As Object, GetNodeK As Object
  16.  
  17.     ReDim arr2(1 To 100000, 1 To 29)
  18.  
  19.     sr = "CKM3N跨月"
  20.     Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")
  21.     If rg Is Nothing Then
  22.         MsgBox "错误！表【" & sr & "】中无数据！"
  23.         Exit Sub
  24.     End If
  25.     arr1 = rg.CurrentRegion.Value
  26.  
  27.     bl = False
  28.     With session
  29.         For x = 2 To UBound(arr1)
  30.             If arr1(x, 1) = "" Then Exit For
  31.             .findById("wnd[0]").maximize
  32.             .findById("wnd[0]/tbar[0]/okcd").Text = "/NCKM3N"
  33.             .findById("wnd[0]").sendVKey 0 'Enter
  34.             .findById("wnd[0]/usr/ctxtMLKEY-WERKS_ML_PRODUCTIVE").Text = arr1(x, 3) '查询工厂
  35.             .findById("wnd[0]/usr/ctxtMLKEY-MATNR").Text = arr1(x, 4) '查询物料
  36.             .findById("wnd[0]/usr/txtMLKEY-POPER").Text = arr1(x, 2) '月
  37.             .findById("wnd[0]/usr/txtMLKEY-BDATJ").Text = arr1(x, 1)  '年
  38.             .findById("wnd[0]/tbar[1]/btn[13]").press '刷新
  39.             .findById("wnd[0]/usr/btn%#AUTOTEXT003").press '折叠选择字段 价格
  40.             For Each v In Split("10;32", ";") '10" '公司层面 '"32"'利润中心层面 ';32
  41.                 .findById("wnd[0]/usr/cmbMLKEY-CURTP").Key = v '货币/评估
  42.                 sr = "wnd[0]/usr/ssubSUB:SAPLCKM8H:0300/cntlCONTAINER/shellcont/shell/shellcont[1]/shell[1]"
  43.                 If Not .findById(sr, False) Is Nothing Then
  44.                    Set Table = .findById(sr)
  45.                    Set Columns = Table.ColumnOrder()
  46.                    Set GetNodeK = Table.GetAllNodeKeys '得到所有的节点
  47.                    For z = 0 To GetNodeK.Count - 1
  48.                        k = k + 1
  49.                        For y = 1 To 4
  50.                            arr2(k, y) = arr1(x, y)
  51.                        Next y
  52.                        arr2(k, 5) = .findById("wnd[0]/usr/cmbMLKEY-CURTP").Text '货币/评估
  53.                        arr2(k, 6) = .findById("wnd[0]/usr/ctxtCKMLCR-VPRSV").Text '价格控制
  54.                        arr2(k, 7) = .findById("wnd[0]/usr/txtCKMLCR-STPRS").Text '标准价格
  55.                        arr2(k, 8) = .findById("wnd[0]/usr/txtCKMLCR-PVPRS").Text '定期价格 '正式区是  wnd[0]/usr/txtCKMLCR-PVPRS '测试区是 wnd[0]/usr/txtPVPRS_DYN
  56.                        arr2(k, 9) = .findById("wnd[0]/usr/txtCKMLCR-PEINH").Text '价格单位
  57.                        arr2(k, 12) = Table.getitemtext(GetNodeK.Item(z), "&Hierarchy")
  58.                        For y = 1 To 17
  59.                            arr2(k, y + 12) = Table.getitemtext(GetNodeK.Item(z), CStr(Columns(y)))
  60.                        Next y
  61.                    Next z
  62.                 End If
  63.              Next v
  64.         Next x
  65.     End With
  66.     For x = 1 To k
  67.         db = arr2(x, 9) '价格单位
  68.         If db <> 0 Then
  69.             arr2(x, 10) = arr2(x, 7) / db '标准价=标准价格/价格单位
  70.             arr2(x, 11) = arr2(x, 8) / db '实际价=定期价格/价格单位
  71.         End If
  72.         arr2(x, 13) = CDbl(arr2(x, 13)) '数量
  73.         For y = 15 To 29
  74.             arr2(x, y) = CDbl(arr2(x, y)) '初级评估等
  75.         Next y
  76.         arr2(x, 3) = "'" & arr2(x, 3) '工厂
  77.     Next x
  78.  
  79.     With ThisWorkbook.Sheets("CKM3N跨月")
  80.         .AutoFilterMode = False
  81.         With .Cells(1, 5)
  82.             .Resize(1, UBound(arr2, 2)).EntireColumn.ClearContents
  83.             .Resize(1, UBound(arr2, 2)) = Split("年;月;工厂;物料;货币评估;价格控制;标准价格;定期价格;价格单位;标准价;实际价;类别;数量;数量单位;初级评估;价格差异;汇率差异;实际值;价格;公司间利润;直接材料;直接人工;间接人员薪资及福利;模具及治工具;资产摊提及能源消耗;耗品及杂项消耗;其他费用;委外加工;成本构成总和", ";")
  84.             If k > 0 Then .Cells(2, 1).Resize(k, UBound(arr2, 2)) = arr2
  85.         End With
  86.     End With
  87. End Sub

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

  1. Sub CKM3N_显示物料价格_明细_单月单笔()
  2.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object
  3.     Set SapGuiAuto = GetObject("SAPGUI")
  4.     Set AppSap = SapGuiAuto.GetScriptingEngine
  5.     Set Connection = AppSap.Children(0)
  6.     Set session = Connection.Children(0)
  7.  
  8.     Dim x As Integer, y As Integer, z As Integer, sr As String, rg As Range, arr1(), k As Integer, brr(), bl As Boolean
  9.     Dim Table As Object, Columns As Object, GetNodeK As Object
  10.     ReDim arr2(1 To 100000, 1 To 18) '此处要提前知道列数，并且加了一列 'Table.ColumnCount()
  11.  
  12.     With session
  13.         Set Table = .findById("wnd[0]/usr/ssubSUB:SAPLCKM8H:0300/cntlCONTAINER/shellcont/shell/shellcont[1]/shell[1]")
  14.         Set Columns = Table.ColumnOrder()
  15.         Set GetNodeK = Table.GetAllNodeKeys '得到所有的节点
  16.         For x = 0 To GetNodeK.Count - 1
  17.             k = k + 1
  18.             arr2(k, 1) = Table.getitemtext(GetNodeK.Item(x), "&Hierarchy")
  19.             For y = 1 To 17 'Table.ColumnCount() - 1
  20.                 arr2(k, y + 1) = Table.getitemtext(GetNodeK.Item(x), CStr(Columns(y)))
  21.             Next y
  22.         Next x
  23.         For x = 1 To k
  24.             For y = 2 To UBound(arr2, 2)
  25.                 If y <> 3 Then
  26.                     If arr2(x, y) = "" Then
  27.                         arr2(x, y) = 0
  28.                     Else
  29.                         arr2(x, y) = CDbl(arr2(x, y))
  30.                     End If
  31.                 End If
  32.             Next y
  33.         Next x
  34.     End With
  35.  
  36.     With ThisWorkbook.Sheets("CKM3N明细")
  37.         .AutoFilterMode = False
  38.         .UsedRange.ClearContents
  39.         .Cells(1, 1).Resize(1, UBound(arr2, 2)) = Split("类别;数量;数量单位;初级评估;价格差异;汇率差异;实际值;价格;公司间利润;直接材料;直接人工;间接人员薪资及福利;模具及治工具;资产摊提及能源消耗;耗品及杂项消耗;其他费用;委外加工;成本构成总和", ";")
  40.         If k > 0 Then .Cells(2, 1).Resize(k, UBound(arr2, 2)) = arr2
  41.     End With
  42. End Sub

FB02

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

  1.  
  2. Sub FB02_修改凭证文本栏位()
  3.     Dim iMg As VbMsgBoxStyle
  4.     iMg = MsgBox("是否修改凭证文本栏位？" & Chr(10) & " " & Chr(10), vbYesNo, "FB02")
  5.     If iMg = 7 Then Exit Sub
  6.  
  7.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object
  8.     Set SapGuiAuto = GetObject("SAPGUI")
  9.     Set AppSap = SapGuiAuto.GetScriptingEngine
  10.     Set Connection = AppSap.Children(0)
  11.     Set session = Connection.Children(0)
  12.     
  13.     Dim Table As Object, Columns As Object
  14.     Dim arr1(), x As Integer, y As Integer, z As Integer, sr As String, rg As Range
  15.     
  16.     sr = "FB02"
  17.     Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")
  18.     If rg Is Nothing Then
  19.         MsgBox "错误！表【" & sr & "】中无数据！"
  20.         Exit Sub
  21.     End If
  22.     arr1 = rg.CurrentRegion.Value
  23.  
  24.     With session
  25.         For z = 2 To UBound(arr1)
  26.             .findById("wnd[0]").maximize
  27.             .findById("wnd[0]/tbar[0]/okcd").Text = "/NFB02" '修改凭证
  28.             .findById("wnd[0]").sendVKey 0
  29.             .findById("wnd[0]/usr/txtRF05L-BELNR").Text = arr1(z, 3) '凭证编号
  30.             .findById("wnd[0]/usr/ctxtRF05L-BUKRS").Text = arr1(z, 2) '公司代码
  31.             .findById("wnd[0]/usr/txtRF05L-GJAHR").Text = arr1(z, 1) '会计年度
  32.             .findById("wnd[0]").sendVKey 0
  33.             '.findById("wnd[0]/usr/cntlCTRL_CONTAINERBSEG/shellcont/shell").selectColumn "SGTXT" '选中“文本”栏位
  34.             '.findById("wnd[0]/usr/cntlCTRL_CONTAINERBSEG/shellcont/shell").pressToolbarButton "&SORT_DSC" '排序
  35.             '.findById("wnd[0]/tbar[1]/btn[25]").press '更改模式
  36.             Set Table = .findById("wnd[0]/usr/cntlCTRL_CONTAINERBSEG/shellcont/shell")
  37.             Set Columns = Table.ColumnOrder()
  38.             For x = 0 To Table.RowCount() - 1
  39.                 If Table.getcellvalue(x, "SGTXT") = arr1(z, 4) Then '原文本
  40.                     Table.SetCurrentCell x, "KTONR"
  41.                     Table.doubleClickCurrentCell '双击
  42.                     .findById("wnd[0]/usr/ctxtBSEG-SGTXT").Text = arr1(z, 5) '更改后文本
  43.                     .findById("wnd[0]/tbar[0]/btn[3]").press '返回
  44.                 End If
  45.                 If x Mod 14 = 0 Then '屏幕上显示的最大行数，根据电脑的不同可能有变
  46.                     Table.SetCurrentCell x, CStr(Columns(0))
  47.                     Table.firstVisibleRow = x
  48.                 End If
  49.             Next x
  50.             .findById("wnd[0]/tbar[0]/btn[11]").press '保存
  51.         Next z
  52.     End With
  53. End Sub

KSU1

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

  1. Sub KSU1_标题()
  2.     Dim arr() As String
  3.     arr = Split("循环名;循环名描述;开始时间;结束时间;段名;段名描述;发送者成本中心从;发送者成本中心至;发送者成本中心组;接收方成本中心从;接收方成本中心至;接收方成本中心组", ";")
  4.  
  5.     With ThisWorkbook.Sheets("KSU1")
  6.         .AutoFilterMode = False
  7.         .Cells(1, 1).Resize(1, UBound(arr) + 1) = arr
  8.     End With
  9. End Sub
  10.  
  11.  
  12. Sub KSU1_创建实际分摊()
  13.     Dim iMg As VbMsgBoxStyle
  14.     iMg = MsgBox("是否创建实际分摊？" & Chr(10) & " " & Chr(10), vbYesNo, "KSU1")
  15.     If iMg = 7 Then Exit Sub
  16.  
  17.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object
  18.     Set SapGuiAuto = GetObject("SAPGUI")
  19.     Set AppSap = SapGuiAuto.GetScriptingEngine
  20.     Set Connection = AppSap.Children(0)
  21.     Set session = Connection.Children(0)
  22.  
  23.     Dim x As Integer, sr As String, rg As Range, arr1()
  24.  
  25.     sr = "KSU1"
  26.     Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")
  27.     If rg Is Nothing Then
  28.         MsgBox "错误！表【" & sr & "】中无数据！"
  29.         Exit Sub
  30.     End If
  31.     arr1 = rg.CurrentRegion.Value
  32.  
  33.  
  34.     With session
  35.         .findById("wnd[0]").maximize
  36.         .findById("wnd[0]/tbar[0]/okcd").Text = "/NKSU1" '创建实际分摊
  37.         .findById("wnd[0]").sendVKey 0 'Enter
  38.         .findById("wnd[0]/usr/ctxtRKAL1-KSCYC").Text = arr1(2, 1) '循环名
  39.         .findById("wnd[0]/usr/ctxtT811C-SDATE").Text = arr1(2, 3)  '开始时间
  40.         .findById("wnd[0]").sendVKey 0 'Enter
  41.         .findById("wnd[0]/usr/ctxtT811C-EDATE").Text = arr1(2, 4) '结束时间
  42.         .findById("wnd[0]/usr/txtRKAL1-CTXT").Text = arr1(2, 2) '循环名描述
  43.  
  44.         For x = 2 To UBound(arr1)
  45.             .findById("wnd[0]/tbar[1]/btn[20]").press '增加段
  46.             .findById("wnd[0]/usr/txtKGALS-NAME").Text = arr1(x, 5) '段名
  47.             .findById("wnd[0]/usr/txtKGALS-TXT").Text = arr1(x, 6) '段名描述
  48.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSQHD/ssubSUB1:SAPMKAL1:0307/ctxtKGALS-ABSCH").Text = "Z3" '分配结构
  49.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSQHD/ssubSUB1:SAPMKAL1:0307/cmbRKAL1-RCDATAFLG").Key = "7" '可变部分类型
  50.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS").Select '发送方/接收方
  51.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[4,67]").Text = "ZZ00" '成本要素组 '修改
  52.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMIN[1,17]").Text = arr1(x, 7)  '发送者成本中心从
  53.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMAX[1,42]").Text = arr1(x, 8) '发送者成本中心至
  54.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[1,67]").Text = arr1(x, 9) '发送者成本中心组
  55.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMIN[7,17]").Text = arr1(x, 10) '接收方成本中心从
  56.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMAX[7,42]").Text = arr1(x, 11)  '接收方成本中心至
  57.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[7,67]").Text = arr1(x, 12)   '接收方成本中心组
  58.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSEND").Select '发送方值
  59.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSEND/ssubSUB1:SAPMKAL1:0451/sub:SAPMKAL1:0451/ctxtKGALK-VALMIN[0,17]").Text = "0" '版本
  60.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE").Select '接收方追踪因素
  61.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE/ssubSUB1:SAPMKAL1:0461/sub:SAPMKAL1:0461/ctxtKGALK-VALMIN[0,17]").Text = "ZZ01" '活动类型：从
  62.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE/ssubSUB1:SAPMKAL1:0461/sub:SAPMKAL1:0461/ctxtKGALK-VALMAX[0,42]").Text = "ZZ06" '活动类型：到
  63.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRWFC").Select '参考加权因素
  64.         Next x
  65.     End With
  66.  
  67.     MsgBox "运行成功！"
  68. End Sub

KSU2

修改已经创建的分摊规则

  1. Sub KSU2_标题()
  2.     Dim arr() As String
  3.     arr = Split("查询循环名;查询开始时间;修改结束时间;修改循环名描述;修改段名;修改段名描述;修改发送者成本中心从;修改发送者成本中心至;修改发送者成本中心组;修改接收方成本中心从;修改接收方成本中心至;修改接收方成本中心组", ";")
  4.  
  5.     With ThisWorkbook.Sheets("KSU2")
  6.         .AutoFilterMode = False
  7.         .Cells(1, 1).Resize(1, UBound(arr) + 1) = arr
  8.     End With
  9. End Sub
  10.  
  11.  
  12. Sub KSU2_修改实际分摊()
  13.     Dim iMg As VbMsgBoxStyle
  14.     iMg = MsgBox("是否修改实际分摊？" & Chr(10) & " " & Chr(10), vbYesNo, "KSU2")
  15.     If iMg = 7 Then Exit Sub
  16.  
  17.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object
  18.     Set SapGuiAuto = GetObject("SAPGUI")
  19.     Set AppSap = SapGuiAuto.GetScriptingEngine
  20.     Set Connection = AppSap.Children(0)
  21.     Set session = Connection.Children(0)
  22.  
  23.     Dim x As Integer, sr As String, rg As Range, arr1(), arr2(), brr(), k As Long, iMax As Integer, i As Integer, j As Integer
  24.     ReDim arr2(1 To 100000, 1 To 18)
  25.     ReDim brr(1 To 3)
  26.  
  27.     sr = "KSU2"
  28.     Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")
  29.     If rg Is Nothing Then
  30.         MsgBox "错误！表【" & sr & "】中无数据！"
  31.         Exit Sub
  32.     End If
  33.     arr1 = rg.CurrentRegion.Value
  34.  
  35.     With session
  36.         .findById("wnd[0]").maximize
  37.         .findById("wnd[0]/tbar[0]/okcd").Text = "/NKSU2" '修改实际分配
  38.         .findById("wnd[0]").sendVKey 0 'Enter
  39.         .findById("wnd[0]/usr/ctxtRKAL1-KSCYC").Text = arr1(2, 1) '循环名
  40.         .findById("wnd[0]/usr/ctxtT811C-SDATE").Text = arr1(2, 2) '开始日期
  41.         .findById("wnd[0]").sendVKey 0 'Enter
  42.         .findById("wnd[0]/usr/ctxtT811C-EDATE").Text = arr1(2, 3) '结束时间
  43.         .findById("wnd[0]/usr/txtRKAL1-CTXT").Text = arr1(2, 4) '循环名描述
  44.         .findById("wnd[0]/tbar[1]/btn[6]").press '第一个段
  45.         .findById("wnd[0]/mbar/menu[2]/menu[1]").Select '转到>>概述段
  46.         j = .findById("wnd[1]/usr/txtRCEVM-ENTRIES").Text '段号
  47.         .findById("wnd[1]/tbar[0]/btn[12]").press '取消段概览
  48.         For x = 1 To j '为了修改的时候不重名
  49.             .findById("wnd[0]/usr/txtKGALS-NAME").Text = x
  50.             If x <> j Then .findById("wnd[0]/tbar[1]/btn[19]").press '下一段
  51.         Next x
  52.         For x = 1 To j - 1 '回退到第一个段
  53.             .findById("wnd[0]/tbar[1]/btn[18]").press '前一段
  54.         Next x
  55.         For x = 2 To UBound(arr1)
  56.             i = i + 1
  57.             .findById("wnd[0]/usr/txtKGALS-NAME").Text = arr1(x, 5) '段名 （不能大于十个字符）
  58.             .findById("wnd[0]/usr/txtKGALS-TXT").Text = arr1(x, 6) '段名描述
  59.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSQHD/ssubSUB1:SAPMKAL1:0307/ctxtKGALS-ABSCH").Text = "Z3" '分配结构
  60.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSQHD/ssubSUB1:SAPMKAL1:0307/cmbRKAL1-RCDATAFLG").Key = "7" '可变部分类型
  61.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS").Select '发送方/接收方
  62.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[4,67]").Text = "ZZ00" '成本要素组
  63.             .findById("wnd[0]/usr/chkKGALS-ACTIVE").Selected = False '锁定标识符
  64.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMIN[1,17]").Text = arr1(x, 7)  '发送者成本中心从
  65.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMAX[1,42]").Text = arr1(x, 8) '发送者成本中心至
  66.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[1,67]").Text = arr1(x, 9) '发送者成本中心组
  67.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMIN[7,17]").Text = arr1(x, 10) '接收方成本中心从
  68.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMAX[7,42]").Text = arr1(x, 11)  '接收方成本中心至
  69.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[7,67]").Text = arr1(x, 12)   '接收方成本中心组
  70.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSEND").Select '发送方值
  71.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSEND/ssubSUB1:SAPMKAL1:0451/sub:SAPMKAL1:0451/ctxtKGALK-VALMIN[0,17]").Text = "0" '版本
  72.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE").Select '接收方追踪因素
  73.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE/ssubSUB1:SAPMKAL1:0461/sub:SAPMKAL1:0461/ctxtKGALK-VALMIN[0,17]").Text = "ZZ01" '活动类型：从
  74.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE/ssubSUB1:SAPMKAL1:0461/sub:SAPMKAL1:0461/ctxtKGALK-VALMAX[0,42]").Text = "ZZ06" '活动类型：到
  75.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRWFC").Select '参考加权因素
  76.             If x = UBound(arr1) Then
  77.             ElseIf i < j Then
  78.                 .findById("wnd[0]/tbar[1]/btn[19]").press
  79.             Else
  80.                 .findById("wnd[0]/tbar[1]/btn[20]").press '增加段
  81.             End If
  82.         Next x
  83.  
  84.         Do While i < j '如果没有修改的必要则全部锁定掉
  85.             i = i + 1
  86.             .findById("wnd[0]/tbar[1]/btn[19]").press '下一个段
  87.             .findById("wnd[0]/usr/chkKGALS-ACTIVE").Selected = "TRUE" '锁定标识符
  88.         Loop
  89.      End With
  90.  
  91.     MsgBox "请自行保存！"
  92. End Sub

KSU3

显示分摊规则

查询循环名查询开始时间
C121012022.06.01
  1. Sub KSU3_标题()
  2.     Dim arr() As String
  3.     arr = Split("查询循环名;查询开始时间;循环名;循环名描述;开始时间;结束时间;段名;段名描述;锁定标识符;分配结构;可变部分类型;成本要素组;发送者成本中心从;发送者成本中心至;发送者成本中心组;接收方成本中心从;接收方成本中心至;接收方成本中心组;版本;活动类型从;活动类型到", ";")
  4.  
  5.     With ThisWorkbook.Sheets("KSU3")
  6.         .AutoFilterMode = False
  7.         .Cells(1, 1).Resize(1, UBound(arr) + 1) = arr
  8.     End With
  9. End Sub
  10.  
  11.  
  12. Sub KSU3_显示实际分摊()
  13.     Dim iMg As VbMsgBoxStyle
  14.     iMg = MsgBox("是否显示实际分摊？" & Chr(10) & " " & Chr(10), vbYesNo, "KSU3")
  15.     If iMg = 7 Then Exit Sub
  16.  
  17.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object
  18.     Set SapGuiAuto = GetObject("SAPGUI")
  19.     Set AppSap = SapGuiAuto.GetScriptingEngine
  20.     Set Connection = AppSap.Children(0)
  21.     Set session = Connection.Children(0)
  22.  
  23.     Dim x As Integer, sr As String, rg As Range, arr1(), arr2(), brr(), k As Long, iMax As Integer, i As Integer, j As Integer
  24.     ReDim arr2(1 To 100000, 1 To 19)
  25.     ReDim brr(1 To 3)
  26.  
  27.     sr = "KSU3"
  28.     Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")
  29.     If rg Is Nothing Then
  30.         MsgBox "错误！表【" & sr & "】中无数据！"
  31.         Exit Sub
  32.     End If
  33.     arr1 = rg.CurrentRegion.Value
  34.  
  35.  
  36.     With session
  37.         For x = 2 To UBound(arr1)
  38.             If arr1(x, 1) <> "" Then
  39.                 .findById("wnd[0]").maximize
  40.                 .findById("wnd[0]/tbar[0]/okcd").Text = "/NKSU3" '显示实际分摊
  41.                 .findById("wnd[0]").sendVKey 0 'Enter
  42.                 .findById("wnd[0]/usr/ctxtRKAL1-KSCYC").Text = arr1(x, 1) '循环名
  43.                 .findById("wnd[0]/usr/ctxtT811C-SDATE").Text = arr1(x, 2) '开始日期
  44.                 .findById("wnd[0]").sendVKey 0 'Enter
  45.                 brr(1) = .findById("wnd[0]/usr/txtRKAL1-CTXT").Text   '循环名描述
  46.                 brr(2) = .findById("wnd[0]/usr/ctxtT811C-SDATE").Text '开始时间
  47.                 brr(3) = .findById("wnd[0]/usr/ctxtT811C-EDATE").Text '结束时间
  48.                 .findById("wnd[0]/tbar[1]/btn[6]").press '第一个段
  49.                 .findById("wnd[0]/mbar/menu[2]/menu[1]").Select '转到>>概述段
  50.                 j = .findById("wnd[1]/usr/txtRCEVM-ENTRIES").Text '段号
  51.                 .findById("wnd[1]/tbar[0]/btn[12]").press '取消段概览
  52.                 i = 0
  53.                 Do
  54.                     On Error Resume Next
  55.                     k = k + 1
  56.                     i = i + 1
  57.                     arr2(k, 1) = arr1(x, 1)
  58.                     arr2(k, 2) = brr(1)
  59.                     arr2(k, 3) = brr(2)
  60.                     arr2(k, 4) = brr(3)
  61.                     arr2(k, 5) = .findById("wnd[0]/usr/txtKGALS-NAME").Text  '段名
  62.                     arr2(k, 6) = .findById("wnd[0]/usr/txtKGALS-TXT").Text '段名描述
  63.                     arr2(k, 7) = .findById("wnd[0]/usr/chkKGALS-ACTIVE").Selected '锁定标识符
  64.                     arr2(k, 8) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSQHD/ssubSUB1:SAPMKAL1:0307/ctxtKGALS-ABSCH").Text '分配结构
  65.                     arr2(k, 9) = Trim(.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSQHD/ssubSUB1:SAPMKAL1:0307/cmbRKAL1-RCDATAFLG").Text) '可变部分类型
  66.                     .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS").Select '发送方/接收方
  67.                     arr2(k, 10) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[4,67]").Text '成本要素组
  68.                     arr2(k, 11) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMIN[1,17]").Text '发送者成本中心从
  69.                     arr2(k, 12) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMAX[1,42]").Text '发送者成本中心至
  70.                     arr2(k, 13) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[1,67]").Text '发送者成本中心组
  71.                     arr2(k, 14) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMIN[7,17]").Text  '接收方成本中心从
  72.                     arr2(k, 15) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMAX[7,42]").Text '接收方成本中心至
  73.                     arr2(k, 16) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[7,67]").Text   '接收方成本中心组
  74.                     .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSEND").Select '发送方值
  75.                     arr2(k, 17) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSEND/ssubSUB1:SAPMKAL1:0451/sub:SAPMKAL1:0451/ctxtKGALK-VALMIN[0,17]").Text '版本
  76.                     .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE").Select  '接收方追踪因素
  77.                     arr2(k, 18) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE/ssubSUB1:SAPMKAL1:0461/sub:SAPMKAL1:0461/ctxtKGALK-VALMIN[0,17]").Text  '活动类型：从
  78.                     arr2(k, 19) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE/ssubSUB1:SAPMKAL1:0461/sub:SAPMKAL1:0461/ctxtKGALK-VALMAX[0,42]").Text     '活动类型：到
  79.                     .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRWFC").Select        '参考加权因素
  80.                     .findById("wnd[0]/tbar[1]/btn[19]").press
  81.                  Loop Until i >= j
  82.                 .findById("wnd[1]/tbar[0]/btn[0]").press
  83.             End If
  84.         Next x
  85.     End With
  87.     With ThisWorkbook.Sheets("KSU3")
  88.         .AutoFilterMode = False
  89.         With .Cells(1, 3)
  90.         .Resize(1, UBound(arr2, 2)).EntireColumn.ClearContents
  91.         .Resize(1, UBound(arr2, 2)) = Split("循环名;循环名描述;开始时间;结束时间;段名;段名描述;锁定标识符;分配结构;可变部分类型;成本要素组;发送者成本中心从;发送者成本中心至;发送者成本中心组;接收方成本中心从;接收方成本中心至;接收方成本中心组;版本;活动类型从;活动类型到", ";")
  92.         If k > 0 Then .Cells(2, 1).Resize(k, UBound(arr2, 2)) = arr2
  93.         End With
  94.     End With
  96.     MsgBox "成功"
  97. End Sub

KSV1、KSV2、KSV3

分配

  1. Sub KSV1_创建实际分配()
  2.     Dim iMg As VbMsgBoxStyle
  3.     iMg = MsgBox("是否创建实际分配？" & Chr(10) & " " & Chr(10), vbYesNo, "KSV1")
  4.     If iMg = 7 Then Exit Sub
  5.  
  6.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object
  7.     Set SapGuiAuto = GetObject("SAPGUI")
  8.     Set AppSap = SapGuiAuto.GetScriptingEngine
  9.     Set Connection = AppSap.Children(0)
  10.     Set session = Connection.Children(0)
  11.  
  12.     Dim x As Integer, sr As String, rg As Range, arr1()
  13.  
  14.     sr = "KSV1"
  15.     Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")
  16.     If rg Is Nothing Then
  17.         MsgBox "错误！表【" & sr & "】中无数据！"
  18.         Exit Sub
  19.     End If
  20.     arr1 = rg.CurrentRegion.Value
  21.  
  22.     With session
  23.         .findById("wnd[0]").maximize
  24.         .findById("wnd[0]/tbar[0]/okcd").Text = "/NKSV1" '创建实际分摊
  25.         .findById("wnd[0]").sendVKey 0 'Enter
  26.         .findById("wnd[0]/usr/ctxtRKAL1-KSCYC").Text = arr1(2, 1) '循环名
  27.         .findById("wnd[0]/usr/ctxtT811C-SDATE").Text = arr1(2, 3)  '开始时间
  28.         .findById("wnd[0]").sendVKey 0 'Enter
  29.         .findById("wnd[0]/usr/ctxtT811C-EDATE").Text = arr1(2, 4) '结束时间
  30.         .findById("wnd[0]/usr/txtRKAL1-CTXT").Text = arr1(2, 2) '循环名描述
  31.  
  32.         For x = 2 To UBound(arr1)
  33.             .findById("wnd[0]/tbar[1]/btn[20]").press '增加段
  34.             .findById("wnd[0]/usr/txtKGALS-NAME").Text = arr1(x, 5) '段名
  35.             .findById("wnd[0]/usr/txtKGALS-TXT").Text = arr1(x, 6) '段名描述
  36.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSQHD/ssubSUB1:SAPMKAL1:0308/cmbRKAL1-RCDATAFLG").Key = "7" '可变部分类型
  37.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS").Select '发送方/接收方
  38.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[3,67]").Text = "ZZ00" '成本要素组
  39.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMIN[1,17]").Text = arr1(x, 7)  '发送者成本中心从
  40.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMAX[1,42]").Text = arr1(x, 8) '发送者成本中心至
  41.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[1,67]").Text = arr1(x, 9) '发送者成本中心组
  42.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMIN[7,17]").Text = arr1(x, 10) '接收方成本中心从
  43.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMAX[7,42]").Text = arr1(x, 11)  '接收方成本中心至
  44.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[7,67]").Text = arr1(x, 12)   '接收方成本中心组
  45.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSEND").Select '发送方值
  46.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSEND/ssubSUB1:SAPMKAL1:0451/sub:SAPMKAL1:0451/ctxtKGALK-VALMIN[0,17]").Text = "0" '版本
  47.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE").Select '接收方追踪因素
  48.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE/ssubSUB1:SAPMKAL1:0461/sub:SAPMKAL1:0461/ctxtKGALK-VALMIN[0,17]").Text = "ZZ01" '活动类型：从
  49.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE/ssubSUB1:SAPMKAL1:0461/sub:SAPMKAL1:0461/ctxtKGALK-VALMAX[0,42]").Text = "ZZ06" '活动类型：到
  50.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRWFC").Select '参考加权因素
  51.         Next x
  52.     End With
  53.  
  54.     MsgBox "运行成功！"
  55. End Sub
  56.  
  57.  
  58.  
  59. Sub KSV3_显示实际分配()
  60.     Dim iMg As VbMsgBoxStyle
  61.     iMg = MsgBox("是否显示实际分配？" & Chr(10) & " " & Chr(10), vbYesNo, "KSV3")
  62.     If iMg = 7 Then Exit Sub
  63.  
  64.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object
  65.     Set SapGuiAuto = GetObject("SAPGUI")
  66.     Set AppSap = SapGuiAuto.GetScriptingEngine
  67.     Set Connection = AppSap.Children(0)
  68.     Set session = Connection.Children(0)
  69.  
  70.     Dim x As Integer, sr As String, rg As Range, arr1(), arr2(), brr(), k As Long, iMax As Integer, i As Integer, j As Integer
  71.     ReDim arr2(1 To 100000, 1 To 18)
  72.     ReDim brr(1 To 3)
  73.  
  74.     sr = "KSV3"
  75.     Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")
  76.     If rg Is Nothing Then
  77.         MsgBox "错误！表【" & sr & "】中无数据！"
  78.         Exit Sub
  79.     End If
  80.     arr1 = rg.CurrentRegion.Value
  81.  
  82.  
  83.     With session
  84.         For x = 2 To UBound(arr1)
  85.             If arr1(x, 1) <> "" Then
  86.  
  87.                 .findById("wnd[0]").maximize
  88.                 .findById("wnd[0]/tbar[0]/okcd").Text = "/NKSV3" '显示实际分配
  89.                 .findById("wnd[0]").sendVKey 0 'Enter
  90.                 .findById("wnd[0]/usr/ctxtRKAL1-KSCYC").Text = arr1(x, 1) '循环名
  91.                 .findById("wnd[0]/usr/ctxtT811C-SDATE").Text = arr1(x, 2) '开始日期
  92.                 .findById("wnd[0]").sendVKey 0 'Enter
  93.                 brr(1) = .findById("wnd[0]/usr/txtRKAL1-CTXT").Text   '循环名描述
  94.                 brr(2) = .findById("wnd[0]/usr/ctxtT811C-SDATE").Text '开始时间
  95.                 brr(3) = .findById("wnd[0]/usr/ctxtT811C-EDATE").Text '结束时间
  96.                 .findById("wnd[0]/tbar[1]/btn[6]").press '第一个段
  97.                 .findById("wnd[0]/mbar/menu[2]/menu[1]").Select '转到>>概述段
  98.                 j = .findById("wnd[1]/usr/txtRCEVM-ENTRIES").Text '段号
  99.                 .findById("wnd[1]/tbar[0]/btn[12]").press '取消段概览
  100.                 i = 0
  101.                 Do
  102.                     On Error Resume Next
  103.                     k = k + 1
  104.                     i = i + 1
  105.                     arr2(k, 1) = arr1(x, 1)
  106.                     arr2(k, 2) = brr(1)
  107.                     arr2(k, 3) = brr(2)
  108.                     arr2(k, 4) = brr(3)
  109.                     arr2(k, 5) = .findById("wnd[0]/usr/txtKGALS-NAME").Text  '段名
  110.                     arr2(k, 6) = .findById("wnd[0]/usr/txtKGALS-TXT").Text '段名描述
  111.                     arr2(k, 7) = .findById("wnd[0]/usr/chkKGALS-ACTIVE").Selected '锁定标识符
  112.                     arr2(k, 8) = Trim(.findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSQHD/ssubSUB1:SAPMKAL1:0308/cmbRKAL1-RCDATAFLG").Text) '可变部分类型
  113.                     .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS").Select '发送方/接收方
  114.                     arr2(k, 9) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[3,67]").Text '成本要素组
  115.                     arr2(k, 10) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMIN[1,17]").Text '发送者成本中心从
  116.                     arr2(k, 11) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMAX[1,42]").Text '发送者成本中心至
  117.                     arr2(k, 12) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[1,67]").Text '发送者成本中心组
  118.                     arr2(k, 13) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMIN[7,17]").Text  '接收方成本中心从
  119.                     arr2(k, 14) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMAX[7,42]").Text '接收方成本中心至
  120.                     arr2(k, 15) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[7,67]").Text   '接收方成本中心组
  121.                     .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSEND").Select '发送方值
  122.                     arr2(k, 16) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSEND/ssubSUB1:SAPMKAL1:0451/sub:SAPMKAL1:0451/ctxtKGALK-VALMIN[0,17]").Text '版本
  123.                     .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE").Select  '接收方追踪因素
  124.                     arr2(k, 17) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE/ssubSUB1:SAPMKAL1:0461/sub:SAPMKAL1:0461/ctxtKGALK-VALMIN[0,17]").Text  '活动类型：从
  125.                     arr2(k, 18) = .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE/ssubSUB1:SAPMKAL1:0461/sub:SAPMKAL1:0461/ctxtKGALK-VALMAX[0,42]").Text     '活动类型：到
  126.                     .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRWFC").Select        '参考加权因素
  127.                     .findById("wnd[0]/tbar[1]/btn[19]").press
  128.                  Loop Until i >= j
  129.                 .findById("wnd[1]/tbar[0]/btn[0]").press
  130.             End If
  131.         Next x
  132.     End With
  133.  
  134.     With ThisWorkbook.Sheets("KSV3")
  135.         .AutoFilterMode = False
  136.         With .Cells(1, 3)
  137.         .Resize(1, UBound(arr2, 2)).EntireColumn.ClearContents
  138.         .Resize(1, UBound(arr2, 2)) = Split("循环名;循环名描述;开始时间;结束时间;段名;段名描述;锁定标识符;可变部分类型;成本要素组;发送者成本中心从;发送者成本中心至;发送者成本中心组;接收方成本中心从;接收方成本中心至;接收方成本中心组;版本;活动类型从;活动类型到", ";")
  139.         If k > 0 Then .Cells(2, 1).Resize(k, UBound(arr2, 2)) = arr2
  140.         End With
  141.     End With
  142.  
  143.     MsgBox "成功"
  144. End Sub
  145.  
  146.  
  147.  
  148. Sub KSV2_修改实际分配()
  149.     Dim iMg As VbMsgBoxStyle
  150.     iMg = MsgBox("是否修改实际分配？" & Chr(10) & " " & Chr(10), vbYesNo, "KSV2")
  151.     If iMg = 7 Then Exit Sub
  152.  
  153.     Dim SapGuiAuto As Object, AppSap As Object, Connection As Object, session As Object
  154.     Set SapGuiAuto = GetObject("SAPGUI")
  155.     Set AppSap = SapGuiAuto.GetScriptingEngine
  156.     Set Connection = AppSap.Children(0)
  157.     Set session = Connection.Children(0)
  158.  
  159.     Dim x As Integer, sr As String, rg As Range, arr1(), arr2(), brr(), k As Long, iMax As Integer, i As Integer, j As Integer
  160.     ReDim arr2(1 To 100000, 1 To 18)
  161.     ReDim brr(1 To 3)
  162.  
  163.     sr = "KSV2"
  164.     Set rg = ThisWorkbook.Sheets(sr).UsedRange.Find("*")
  165.     If rg Is Nothing Then
  166.         MsgBox "错误！表【" & sr & "】中无数据！"
  167.         Exit Sub
  168.     End If
  169.     arr1 = rg.CurrentRegion.Value
  170.  
  171.     With session
  172.         .findById("wnd[0]").maximize
  173.         .findById("wnd[0]/tbar[0]/okcd").Text = "/NKSV2" '修改实际分配
  174.         .findById("wnd[0]").sendVKey 0 'Enter
  175.         .findById("wnd[0]/usr/ctxtRKAL1-KSCYC").Text = arr1(2, 1) '循环名
  176.         .findById("wnd[0]/usr/ctxtT811C-SDATE").Text = arr1(2, 2) '开始日期
  177.         .findById("wnd[0]").sendVKey 0 'Enter
  178.         .findById("wnd[0]/usr/ctxtT811C-EDATE").Text = arr1(2, 3) '结束时间
  179.         .findById("wnd[0]/usr/txtRKAL1-CTXT").Text = arr1(2, 4) '循环名描述
  180.         .findById("wnd[0]/tbar[1]/btn[6]").press '第一个段
  181.         .findById("wnd[0]/mbar/menu[2]/menu[1]").Select '转到>>概述段
  182.         j = .findById("wnd[1]/usr/txtRCEVM-ENTRIES").Text '段号
  183.         .findById("wnd[1]/tbar[0]/btn[12]").press '取消段概览
  184.         For x = 1 To j '为了修改的时候不重名
  185.             .findById("wnd[0]/usr/txtKGALS-NAME").Text = x
  186.             If x <> j Then .findById("wnd[0]/tbar[1]/btn[19]").press '下一段
  187.         Next x
  188.         For x = 1 To j - 1 '回退到第一个段
  189.             .findById("wnd[0]/tbar[1]/btn[18]").press '前一段
  190.         Next x
  191.         For x = 2 To UBound(arr1)
  192.             i = i + 1
  193.             .findById("wnd[0]/usr/txtKGALS-NAME").Text = arr1(x, 5) '段名 （不能大于十个字符）
  194.             .findById("wnd[0]/usr/txtKGALS-TXT").Text = arr1(x, 6) '段名描述
  195.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSQHD/ssubSUB1:SAPMKAL1:0308/cmbRKAL1-RCDATAFLG").Key = "7" '可变部分类型
  196.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS").Select '发送方/接收方
  197.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[3,67]").Text = "ZZ00" '成本要素组
  198.             .findById("wnd[0]/usr/chkKGALS-ACTIVE").Selected = arr1(x, 7) '锁定标识符
  199.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMIN[1,17]").Text = arr1(x, 8)  '发送者成本中心从
  200.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMAX[1,42]").Text = arr1(x, 9) '发送者成本中心至
  201.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[1,67]").Text = arr1(x, 10) '发送者成本中心组
  202.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMIN[7,17]").Text = arr1(x, 11) '接收方成本中心从
  203.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-VALMAX[7,42]").Text = arr1(x, 12)  '接收方成本中心至
  204.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpOBJS/ssubSUB1:SAPMKAL1:0306/sub:SAPMKAL1:0306/ctxtKGALK-SETID[7,67]").Text = arr1(x, 13)   '接收方成本中心组
  205.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSEND").Select '发送方值
  206.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpSEND/ssubSUB1:SAPMKAL1:0451/sub:SAPMKAL1:0451/ctxtKGALK-VALMIN[0,17]").Text = "0" '版本
  207.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE").Select '接收方追踪因素
  208.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE/ssubSUB1:SAPMKAL1:0461/sub:SAPMKAL1:0461/ctxtKGALK-VALMIN[0,17]").Text = "ZZ01" '活动类型：从
  209.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRECE/ssubSUB1:SAPMKAL1:0461/sub:SAPMKAL1:0461/ctxtKGALK-VALMAX[0,42]").Text = "ZZ06" '活动类型：到
  210.             .findById("wnd[0]/usr/tabsSEG_TABSTRIP/tabpRWFC").Select '参考加权因素
  211.             If x = UBound(arr1) Then
  212.             ElseIf i < j Then
  213.                 .findById("wnd[0]/tbar[1]/btn[19]").press
  214.             Else
  215.                 .findById("wnd[0]/tbar[1]/btn[20]").press '增加段
  216.             End If
  217.         Next x
  218.  
  219.         Do While i < j '如果没有修改的必要则全部锁定掉
  220.             i = i + 1
  221.             .findById("wnd[0]/tbar[1]/btn[19]").press '下一个段
  222.             .findById("wnd[0]/usr/chkKGALS-ACTIVE").Selected = "TRUE" '锁定标识符
  223.         Loop
  224.      End With
  225.  
  226.     MsgBox "成功"
  227. End Sub

与其他方式对比

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

声明：本文内容由网友自发贡献，不代表【wpsshop博客】立场，版权归原作者所有，本站不承担相应法律责任。如您发现有侵权的内容，请联系我们。转载请注明出处：https://www.wpsshop.cn/w/花生_TL007/article/detail/651248
推荐阅读
相关标签

Copyright © 2003-2013 www.wpsshop.cn 版权所有，并保留所有权利。

  

闽ICP备14008679号