使用VBA生成设备调拨单

　　处理完成资产核对以后，需要手工生成调拨单，就是资产表上的设备在别的单位，那么就应该生成设备调拨单。
　　这个工作简单，但是单位多的话，比如30个单位就可能有900张的设备调拨单，手工处理起来还是很费精力。
　　使用VBA可以替代手工操作。
　　1、读取调出单位和调入单位的设备记录信息

Function ReadyTransferInfo(STransferOut As String, STransferIn As String)'准备提取调出单位、调入单位的数据记录，返回一个二维数组Dim ws As WorksheetDim LastRow As LongDim iFor As IntegerDim MatchCell_ZCBUnitname As Range      '资产表的单位名称Dim MatchCell_RealUnitname As Range     '实际的单位名称Dim MatchCell_AssetCode As Range        '资产编码Dim MatchCell_AssetName As Range        '资产名称Dim MatchCell_RealGGXH As Range         '实际的规格型号Dim MatchCell_FactoryDate As Range      '出厂日期Dim MatchCell_MeasureUnit As Range      '计量单位Dim MatchCell_InitMoney As Range        '账面原值Dim IArrCount As IntegerDim ZCBUnitName As StringDim RealUnitName As StringDim SAssetCode As StringDim SAssetName As StringDim RealGGXH As StringDim FactoryDate As StringDim MeasureUnit As StringDim InitMoney As String                 '账面原值Dim SInfoArr() As StringDim IArrLength As Integer               '判断需要定义数组的大小'设置范围Set ws = Worksheets("OK资产表")LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).RowSet MatchCell_ZCBUnitname = ws.Range("D2:D" & Trim(Str(LastRow)))   '资产表单位Set MatchCell_RealUnitname = ws.Range("H2:H" & Trim(Str(LastRow)))  '实际单位Set MatchCell_AssetCode = ws.Range("A2:A" & Trim(Str(LastRow)))     '资产编码Set MatchCell_AssetName = ws.Range("B2:B" & Trim(Str(LastRow)))     '资产名称Set MatchCell_RealGGXH = ws.Range("I2:I" & Trim(Str(LastRow)))      '实际规格型号Set MatchCell_FactoryDate = ws.Range("L2:L" & Trim(Str(LastRow)))   '出厂日期Set MatchCell_MeasureUnit = ws.Range("AD2:AD" & Trim(Str(LastRow))) '计量单位Set MatchCell_FactoryDate = ws.Range("L2:L" & Trim(Str(LastRow)))   '出厂日期Set MatchCell_InitMoney = ws.Range("BW2:BW" & Trim(Str(LastRow)))   '计税原值For iFor = 1 To LastRow - 1ZCBUnitName = UCase(Trim(MatchCell_ZCBUnitname(iFor).Value))RealUnitName = UCase(Trim(MatchCell_RealUnitname(iFor).Value))If ZCBUnitName = STransferOut And RealUnitName = STransferIn ThenIArrLength = IArrLength + 1End IfNextReDim SInfoArr(IArrLength, 6) As StringIArrCount = 0'检索涉及的信息For iFor = 1 To LastRow - 1ZCBUnitName = UCase(Trim(MatchCell_ZCBUnitname(iFor).Value))RealUnitName = UCase(Trim(MatchCell_RealUnitname(iFor).Value))If ZCBUnitName = STransferOut And RealUnitName = STransferIn ThenSAssetCode = UCase(Trim(MatchCell_AssetCode(iFor).Value))       '资产编码SAssetName = UCase(Trim(MatchCell_AssetName(iFor).Value))       '资产名称RealGGXH = UCase(Trim(MatchCell_RealGGXH(iFor).Value))          '规格型号FactoryDate = UCase(Trim(MatchCell_FactoryDate(iFor).Value))    '出厂日期MeasureUnit = UCase(Trim(MatchCell_MeasureUnit(iFor).Value))    '计量单位InitMoney = UCase(Trim(MatchCell_InitMoney(iFor).Value))        '计税原值IArrCount = IArrCount + 1SInfoArr(IArrCount, 0) = SAssetCodeSInfoArr(IArrCount, 1) = SAssetNameSInfoArr(IArrCount, 2) = RealGGXHSInfoArr(IArrCount, 3) = FactoryDateSInfoArr(IArrCount, 4) = MeasureUnitSInfoArr(IArrCount, 5) = InitMoneyEnd IfNextReadyTransferInfo = SInfoArr
End Function

　　2、生成设备调拨单

Sub GenerateTransferForm(STransferOut As String, STransferIn As String)Dim wdApp As Word.ApplicationDim wdDoc As Word.DocumentDim SSaveFileName As StringDim wdTable As Word.TableDim iFor As IntegerDim IRowCount As IntegerDim tbl As TableDim NewRow As RowDim SDDDate As StringDim STransferInfoArr() As StringDim TotalAmount As Single'获取需要生成调拨单的数据记录STransferInfoArr = ReadyTransferInfo(STransferOut, STransferIn)'打开模板文件写数据Set wdApp = New Word.ApplicationSet wdDoc = wdApp.Documents.Open("F:\调拨单模板.doc")Set tbl = wdDoc.Tables(1)wdApp.Visible = FalseSDDDate = Format(Now(), "yyyy年mm月dd日")SSaveFileName = "F:\2023年OK\" & STransferOut + "—〉" & STransferIn & ".doc"ActiveDocument.Bookmarks("调出单位").Range.Text = STransferOutActiveDocument.Bookmarks("调入单位").Range.Text = STransferInActiveDocument.Bookmarks("调动日期").Range.Text = SDDDateSet wdTable = ActiveDocument.Tables(1)IRowCount = 0IRowCount = UBound(STransferInfoArr, 1)If IRowCount > 12 ThenFor iFor = 1 To IRowCount - 13tbl.Rows.Add (tbl.Rows(1).Next)NextEnd IfFor iFor = 1 To IRowCountTotalAmount = TotalAmount + CCur(STransferInfoArr(iFor, 5))   'CDec、CDbl函数NextFor iFor = 1 To UBound(STransferInfoArr, 1)wdTable.Cell(iFor + 1, 1).Range.Text = STransferInfoArr(iFor, 0)wdTable.Cell(iFor + 1, 2).Range.Text = STransferInfoArr(iFor, 1)wdTable.Cell(iFor + 1, 3).Range.Text = STransferInfoArr(iFor, 2)wdTable.Cell(iFor + 1, 4).Range.Text = STransferInfoArr(iFor, 3)wdTable.Cell(iFor + 1, 5).Range.Text = STransferInfoArr(iFor, 4)wdTable.Cell(iFor + 1, 6).Range.Text = "1"wdTable.Cell(iFor + 1, 7).Range.Text = STransferInfoArr(iFor, 5)wdTable.Cell(iFor + 1, 8).Range.Text = "生产需要"Next iFor'填写合计If IRowCount > 12 ThenwdTable.Cell(iFor + 1, 7).Range.Text = Str(TotalAmount)wdTable.Cell(iFor + 1, 2).Range.Text = IRowCountElsewdTable.Cell(14, 7).Range.Text = Str(TotalAmount)wdTable.Cell(14, 2).Range.Text = IRowCountEnd IfwdDoc.SaveAs SSaveFileNamewdDoc.ClosewdApp.Quit'Set wdDoc = noting'Set wdApp = noting
End Sub

　　3、循环生成所有的调拨单
　　例如要生成调出单位为信息中心、调入单位为收发室的调拨单，调用函数即可

Call GenerateTransferForm("信息中心", "收发室")

　　4、打印调拨单

Sub printdoc()Dim folderPath As StringDim wordFile As StringDim PrintFileName As StringDim wdApp As Word.ApplicationDim wdDoc As Word.DocumentfolderPath = "F:\调拨单\"    wordFile = Dir(folderPath & "*.doc")Set wdApp = New Word.ApplicationDo While wordFile <> ""PrintFileName = folderPath & wordFileDebug.Print "OK:" & PrintFileNameSet wdDoc = wdApp.Documents.Open(PrintFileName)Sleep 500wdDoc.PrintOut        Sleep 500wdDoc.CloseSet wdDoc = NothingSleep 1000' 处理下一个文件wordFile = DirLoopwdApp.QuitSet wdApp = Nothing    MsgBox "打印完毕！"
End Sub

　　VBA还是挺管用的，在日常的工作当中，适当地应用可以替代不少的人工操作，省事又有效率。

　　虽然VBA使用很方便，用过就会有体会，但是要熟练掌握需要了解Word、Excel、PPT的对象模型，同样的操作可以使用的方式方法却多样。

　　VBA很有用，值得用心留意，编程语言很多，对于IT人员而言，编程语言就像是自己的作战工具，对于不同的战斗自然有不同的应对工具。比如有的需要就凭借自身功力，有的可以使用一般的编程工具，大的战斗使用Java和C#，也可以使用一些前端的开发工具等等。

　　VBA需要总结了，方便以后的查找与应用。

使用VBA生成设备调拨单相关推荐

【用友U8】调拨单参照生产订单制单时，先扣减线边仓库存，再生成需仓库配发数量的调拨单（生产调拨模拟操作步骤）。
1.在调拨单菜单栏点击[增加],选择[生产调拨模拟]: 2.选择需要作调拨的生产订单–>点击确定,弹出调拨建议处理界面: 3.输入转出仓库,将[考虑转入仓库库存]的值改为是: 4.点击[运算]按 ...
odoo-025 在采购订单中添加一个调拨单
文章目录客户要求技术分析实际操作客户要求在确认调拨单的时候,忘记生成欠单了,想自己生成一个调拨单,然后关联到相应的采购订单上. 技术分析对象直接的关系: 采购订单(purchase.ord ...
金蝶云星空与四化智造MES（API）对接集成调拨单查询打通新增物料
接通系统:金蝶云星空金蝶K/3Cloud(金蝶云星空)是移动互联网时代的新型ERP,是基于WEB2.0与云技术的新时代企业管理服务平台.金蝶K/3Cloud围绕着"生态.人人.体验&quo ...
如何自动生成推荐歌单：ACM论文翻译与解读 | Translation and Interpretation of ACM Survey
如何自动生成推荐歌单:ACM论文翻译与解读 | How to Automatically Generate Music Playlists: Translation and Interpretatio ...
用友U8调拨单、组装拆卸单、盘点单审核后自动审核对应的其他出入库单
用友U8+中,调拨单.组装拆卸单.盘点单审核后,自动审核对应的其他出入库单. 解决方法针对账套库执行,查询语句: select * from AccInformation where cSysID ...
【U8】调拨单审核后自动审核对应的其他出入库单
需求描述: U8V13.0,客户希望调拨单审核后,自动审核对应的其他出入库单. 解决办法: 打库存管理(ST)补丁,并执行以脚本:(该脚本对于自动审核组装拆卸单.盘点单生成的其他出入库单同样有效.) ...
关于实仓与虚仓和调拨单和虚仓调拨单的区别
何谓实仓?何谓虚仓? 核算成本的仓库我们称之为实仓,不核算成本的仓库我们称之为虚仓. 调拨单和虚仓调拨单的区别 1.实仓同实仓之间的调拨业务:这种业务主要处理不同实仓间的货品调拨,由于实仓是需要核算货 ...
金蝶云星空对接打通旺店通·企业奇门调拨单查询接口与创建其他出库单接口
数据源平台:金蝶云星空金蝶K/3Cloud在总结百万家客户管理最佳实践的基础上,提供了标准的管理模式:通过标准的业务架构:多会计准则.多币别.多地点.多组织.多税制应用框架等,有效支持企业的运营管理 ...
伯俊ERP与金蝶云星空对接集成=＞调拨单新增
数据源平台:伯俊ERP 伯俊科技不断为品牌提供更全面的零售终端致胜利器.伯俊科技始终坚持创新发展,探索大零售行业发力方向及突破机会,不断总结提炼当前及未来的新场景新玩法,优化升级自身体系的同时陪伴客户 ...

使用VBA生成设备调拨单

使用VBA生成设备调拨单相关推荐

最新文章

热门文章