Excel插件的制作方法.doc

Excel插件的制作方法一、问题描述：从crm系统中导出的表格，与实际需要的形式有许多不相适应的地方，以往都是通过大量的人工操作修改成所需形式。但是当发货量不断增加时，手工修改需要浪费大量的时间和精力；并且难以保证数据的准确性；这时就迫切的需要改进方法以适应新的要求。在发货表中最难整理，也是最浪费时间的地方主要有以下两处：1、 订购产品的整理：原始表格中的订购产品形式如下： 图1-1需要将此列修改成如下形式： 图1-2难点：正品和赠品的区分；产品和数量的分离；金额的添加2、 发货产品的统计：本模块需要实现两个功能：首先是统计出当日的发货产品有哪些；其次是计算出每种产品的发货数量。需要使用字典的方法。二、解决办法：用Excel vba解决；做成Excel插件三、开发环境：Excel 2007四、知识准备：Excel vba基本编程知识，数组和字典；Xml语言五、基本想法：在Excel中自定义一个选项卡My_Tools；在My_Tools选项卡中定义一个名为发货表的工具选项卡；该工具选项卡中有5个功能模块：格式化、分列；添加金额；产品统计；设置密码。最终实现效果如下图。 图1-3效果图每个模块的功能：格式化：删除多余的列；统一字体字号；列宽；设置单元格格式；分列：将订购产品一列；正品和赠品分离；产品和数量分离；套餐中加入批注添加金额：对相应的正品添加金额；产品统计：统计发货表中的产品及相应数量；设置密码：对工作簿设置读写密码；对工作表设置保护密码；六、操作步骤：第一步：在桌面上创建一个名为customUI文件；在记事本中写入如下代码，文件命名为customUI.xml，编码为UTF-8，保存在customUI文件中。 第二步：在桌面上新建一个启用宏的Excel文件，并命名为MyCustomUI.xlsm，因为在自定义的XML中，包含了产生回调的onAction属性，所以创建的Excel文件需要启用宏。第三步：在MyCustomUI.xlsm中，按Alt+F11组合键打开VBE，并插入一个标准模块，添加下面的代码供回调使用Sub price_add(control As IRibbonControl) Dim i, j, rownum, colnum Dim Wb As Workbook Dim arr, arr2, arr3 rownum = a65536.End(xlUp).Row colnum = iv1.End(xlToLeft).Column 不打开product.xls文件实现对其中数据的引用 Set Wb = GetObject(C:Documents and SettingsAdministratorApplication DataMicrosoftAddIns product.xls) 单价*数量=金额 For j = 1 To colnum If Cells(1, j).Text Like 订购产品* Then For i = 2 To rownum If Cells(i, j) Then Cells(i, j + 2) = Application.VLookup(Cells(i, j), Wb.Worksheets(product).a1.CurrentRegion, 2, False) * Cells(i, j + 1) End If Next End If Next 实收金额，应收金额，预存款 For i = 2 To rownum For j = 1 To colnum If Cells(1, j).Text Like 订单金额 Then arr = Cells(i, j) End If If Cells(1, j).Text Like 订购产品* Then arr2 = arr2 + Cells(i, j + 2) End If If Cells(1, j).Text Like 实收金额* Then If arr = arr2 Then Cells(i, j) = arr Else Cells(i, j) = arr Cells(i, j + 1) = arr2 Cells(i, j + 2) = arr - arr2 End If End If Next arr2 = 0 Next End SubSub 分列(control As IRibbonControl)Dim arr, arr2, arr3(1 To 100, 1 To 2)Dim rownum, col_num, num, n, m, max1, max2rownum = a65536.End(xlUp).RowFor i = 1 To 100 If Cells(1, i).Text = 订购产品 Then col_num = i End IfNext arr = Range(Cells(2, col_num), Cells(rownum, col_num)Range(Cells(2, col_num), Cells(rownum, col_num).ClearContents确定正品和赠品最多有多少个For i = LBound(arr) To UBound(arr) arr2 = Split(arr(i, 1), ;) For j = LBound(arr2) To UBound(arr2) If InStr(arr2(j), 正品) Or InStr(arr2(j), 套餐) Then n = n + 1 ElseIf InStr(arr2(j), 赠品) Or InStr(arr2(j), 配件) Then m = m + 1 End If Next If max1 n Then max1 = n If max2 m Then max2 = m n = 0m = 0 Next 正品和赠品分开 For i = LBound(arr) To UBound(arr) arr2 = Split(arr(i, 1), ;) For j = LBound(arr2) To UBound(arr2) If InStr(arr2(j), 正品) Or InStr(arr2(j), 套餐) Then n = n + 1 If InStr(arr2(j), 正品) Then num1 = InStr(arr2(j), 正品) num2 = InStr(arr2(j), *) Cells(i + 1, col_num + 3 * (n - 1) = Mid(arr2(j), num1 + 4, num2 - num1 - 4) Cells(i + 1, col_num + 1 + 3 * (n - 1) = Mid(arr2(j), num2 + 1) Else num1 = InStr(arr2(j), 套餐) num2 = InStr(arr2(j), *) Cells(i + 1, col_num + 3 * (n - 1) = Mid(arr2(j), num1 + 4, num2 - num1 - 4) 套餐加批注 Select Case Cells(i + 1, col_num + 3 * (n - 1).Text Case 高血压套餐 Cells(i + 1, col_num + 3 * (n - 1).AddComment Text:=PO: & Chr(10) & 林怀恩降压专方3盒；核聚元组方3组；易疏通降压仪1台；海豹油5瓶 Case 糖尿病套餐 Cells(i + 1, col_num + 3 * (n - 1).AddComment Text:=PO: & Chr(10) & 李广澄降糖专方3盒；核聚元组方3组；巴西降糖蜂胶2瓶 Case 冠心病套餐 Cells(i + 1, col_num + 3 * (n - 1).AddComment Text:=PO: & Chr(10) & 刘承贤冠心病专方3盒；核聚元组方3组；银杏红曲 胶囊3瓶 Case 肠胃病套餐 Cells(i + 1, col_num + 3 * (n - 1).AddComment Text:=PO: & Chr(10) & 顾悦庭胃病专方3盒；核聚元组方3组；活谓素6瓶 Case 风湿骨病套餐 Cells(i + 1, col_num + 3 * (n - 1).AddComment Text:=PO: & Chr(10) & 傅雨轩蛇酒专方3瓶；核聚元组方3组；金谷力 水德胶囊4瓶 Case 慢性肾病套餐 Cells(i + 1, col_num + 3 * (n - 1).AddComment Text:=PO: & Chr(10) & 御金方优晶二号6盒；核聚元组方3组 End Select Cells(i + 1, col_num + 1 + 3 * (n - 1) = Mid(arr2(j), num2 + 1) End If ElseIf InStr(arr2(j), ) Then m = m + 1 num1 = InStr(arr2(j), ) num2 = InStr(arr2(j), *) Cells(i + 1, 3 * max1 + 2 * (m - 1) + col_num) = Mid(arr2(j), num1 + 4, num2 - num1 - 4) Cells(i + 1, 3 * max1 + 2 * (m - 1) + 1 + col_num) = Mid(arr2(j), num2 + 1) End If Next n = 0m = 0Next第一行添加订购产品数量金额，赠品数量，实收金额、应收金额、本次预存款、累计预存款、政策返款For i = 1 To max1 Cells(1, 3 * (i - 1) + col_num) = 订购产品 & i Cells(1, 3 * (i - 1) + 1 + col_num) = 数量 Cells(1, 3 * (i - 1) + 2 + col_num) = 金额NextFor i = 1 To max2 Cells(1, 2 * (i - 1) + col_num + 3 * max1) = 赠品 & i Cells(1, 2 * (i - 1) + 1 + col_num + 3 * max1) = 数量NextCells(1, 3 * max1 + 2 * max2 + col_num) = 实收金额Cells(1, 3 * max1 + 2 * max2 + col_num + 1) = 应收金额Cells(1, 3 * max1 + 2 * max2 + col_num + 2) = 本次预存款Cells(1, 3 * max1 + 2 * max2 + col_num + 3) = 累计预存款Cells(1, 3 * max1 + 2 * max2 + col_num + 4) = 政策返款End SubSub 发货产品统计(control As IRibbonControl)Set d = CreateObject(scripting.dictionary)Dim rownum As Integer, colnum, rownum2Dim product, mountDim Sh As Worksheetrownum = a65536.End(xlUp).Rowcolnum = iv1.End(xlToLeft).Column添加发货产品统计表temp = ActiveWorkbook.NameIf Sheets.Count = 1 Then With Worksheets Set Sh = .Add(after:=Worksheets(.Count) Sh.Name = Left(temp, InStr(temp, .xls) - 1) & 产品统计 End WithElseIf Sheets(2).Name = Sheet2 Then With Worksheets Sheets(2).Name = Left(temp, InStr(temp, .xls) - 1) & 产品统计 End WithEnd If设置sheet2中的第一行为黄色，其中的单元格行高21，列宽10，文本居中，垂直居中以及边框颜色 Sheets(2).Rows(1:1).Interior.Color = 65535 With Sheets(2).Cells .RowHeight = 21 .ColumnWidth = 10 .Font.Size = 9 .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = True .Borders(xlEdgeLeft).Color = -8355712 .Borders(xlEdgeTop).Color = -8355712 .Borders(xlEdgeBottom).Color = -8355712 .Borders(xlEdgeRight).Color = -8355712 .Borders(xlInsideVertical).Color = -8355712 .Borders(xlInsideHorizontal).Color = -8355712 End With用字典法查找Sheet1表中的产品的种类和数量，并将其添加到Sheet2中For j = 1 To colnum If Sheets(1).Cells(1, j).Text Like 订购产品* Or Sheets(1).Cells(1, j).Text Like 赠品* Then For i = 1 To rownum d(Sheets(1).Cells(i + 1, j).Value) = d(Sheets(1).Cells(i + 1, j).Value) + Sheets(1).Cells(i + 1, j + 1).Value Next End IfNextd.Remove ()product = d.keysmount = d.itemsApplication.ActiveWorkbook.Sheets(2).a2.Resize(d.Count, 1) = Application.Transpose(product)Application.ActiveWorkbook.Sheets(2).b2.Resize(d.Count, 1) = Application.Transpose(mount)Application.ActiveWorkbook.Sheets(2).a1.Resize(1, 2) = Array(发货产品, 数量)Set d = Nothing调整发货产品统计中A列的宽度为自适应，对齐方式为左对齐Sheets(2).Columns(A:A).Columns.AutoFitSheets(2).Columns(A:A).HorizontalAlignment = xlLeft自动筛选Sheets(1).Cells.AutoFilterSheets(2).Cells.AutoFilter以A列发货产品升序排列 rownum2 = Sheets(2).a65536.End(xlUp).Row Sheets(2).Sort.SortFields.ClearSheets(2).Sort.SortFields.Add Key:=Range(A2:A & rownum2), SortOn:=xlSortOnValues, Order:= xlAscending, DataOption:= xlSortNormalWith Sheets(2).Sort .SetRange Range(A1:B & rownum2) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End WithEnd SubSub 格式化(control As IRibbonControl)Dim arr()Dim rownum, colnum Rows(1:1).Interior.Color = 65535 第一行标为黄色 Cells.Select With Selection .RowHeight = 21 .ColumnWidth = 10 .Font.Size = 9 .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = True .NumberFormatLocal = G/通用格式 .Borders(xlEdgeLeft).Color = -8355712 .Borders(xlEdgeTop).Color = -8355712 .Borders(xlEdgeBottom).Color = -8355712 .Borders(xlEdgeRight).Color = -8355712 .Borders(xlInsideVertical).Color = -8355712 .Borders(xlInsideHorizontal).Color = -8355712 End With rownum = a65536.End(xlUp).Row colnum = iv1.End(xlToLeft).Column ReDim arr(1 To rownum, 1 To 8) For j = 1 To colnum If Cells(1, j).Text = 坐席姓名 Or Cells(1, j).Text = 坐席组 Or Cells(1, j).Text = 客户名称 Or Cells(1, j).Text = 客户地址 Or Cells(1, j).Text = 订单金额 Or Cells(1, j).Text = 运单号 Or Cells(1, j).Text = 订购产品 Then k = k + 1 For i = 1 To rownum arr(i, k + 1) = Cells(i, j) Next ElseIf Cells(1, j).Text = 发货时间 Then For i = 1 To rownum arr(i, 1) = Cells(i, j) Next End If Next For i = 2 To rownum arr(i, 5) = Left(arr(i, 5), 2) If arr(i, 5) = 黑龙 Then arr(i, 5) = 黑龙江 ElseIf arr(i, 5) = 内蒙 Then arr(i, 5) = 内蒙古 End If Next a1.CurrentRegion.ClearContents 清除工作表的内容 a1.Resize(rownum, 8) = arr 将格式化后的内容写入工作表 Columns(A:A).NumberFormatLocal = yyyy-m-d 设置第一列的单元格格式为日期格式 End SubSub 设置密码(control As IRibbonControl)For i = 1 To Sheets.Count Sheets(i).Protect DrawingObjects:=False, Contents:=True, Scenarios:= _ False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _ AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True, _ AllowUsingPivotTables:=True, Password:=101Next ChDir C:Documents