1、设计界面，参考上面的运行时设计界面【图2】即可；
2、创建DataFiles文件，用于存放导入导出的Excel或Csv模板来使用的。1、DataFiles文件夹里主要包含三个文件 TplPeiFang.csv（需要导入的CSV模板格式）、TplPeiFang.xlsx（需要导入的Excel模板格式）、TplPeiFangExport.xlsx（导出Excel需要被复制的模板）。如【图1】【图2】2、为TplPeiFang.csv 和 TplPeiFang.xlsx的格式如【图3】
3、窗口设计相关的脚本事件如下4个1、导入按钮 左键按下 事件2、导出按钮 左键按下 事件3、查询按钮 左键按下事件4、查询按钮 左键抬起事件
4、导入按钮 左键按下事件：Dim errorDes1,errorDes2,errorTitleDim fileExtArray,f足毂忍珩ileName,filePath,fileExt,fileExtIsTrue,fileNameSplitArrayfileExtIsTrue=FalsefilePath=Sys.ProjectDir & "\DataFiles\"fileExtArray=Array("csv","xlsx","xls")fileName=Trim(文本框3.Text)errorTitle="系统提示"errorDes1="请输入文件名"errorDes2="文件格式只支持：csv,xlsx,xls"errorDes3="文件模板不存在"'===================================================S_判断输入文件格式是否正确'判断文件不能为空If Len(fileName)<=0 then MsgBox errorDes1,0,errorTitle Exit SubEnd IffileNameSplitArray=Split(fileName,".",-1,1)'判断文件格式 为 xxxx.xxxIf UBound(fileNameSplitArray)<>1 then MsgBox errorDes2,0,errorTitle Exit SubEnd If'判断文件格式只支持 csv,xlsx,xlsfileExt=LCase(Trim(fileNameSplitArray(1)))'去除左右两边空格，并将大写字母转换成小写字母For i=0 To UBound(fileExtArray) If fileExt=fileExtArray(i) then fileExtIsTrue=True Exit For End IfNextIf fileExtIsTrue=False then MsgBox errorDes2,0,errorTitle Exit SubEnd If'判断模板文件是否存在Set objFSO = CreateObject("Scripting.FileSystemObject")filePath=filePath & fileNameIf not objFSO.fileExists(filePath) then MsgBox errorDes3,0,errorTitle Exit Sub End IfSet objFSO = nothing'===================================================EndDim recipeItemList,recipeItemListCount,peiFangXiangNameDim recipeName,sheetNameDim iDHao,peiFangNeiRongrecipeName="Recipe.板件"sheetName="板件"'===================================================S_Excel导入操作If fileExt="xlsx" Or fileExt="xls" then Dim xlApp,xlWorkBook,xlSheet Set xlApp = CreateObject("Excel.Application") xlApp.Visible = false Set xlWorkBook = xlApp.Workbooks.Open(filePath) Set xlSheet = xlWorkBook.Sheets(sheetName) '删除原有的配方项 recipeItemList=RecipeCmd.GetRecipeItemList(recipeName) recipeItemListCount=recipeItemList.Count If recipeItemListCount>0 then For i=0 To recipeItemListCount-1 recipeItemName=recipeItemList(i) Call RecipeCmd.RemoveRecipeItem(RecipeName,recipeItemName) Next End If '读取Excel，配方项最多限制1000个 For i=2 To 1000 peiFangXiangName = xlApp.WorkSheets(SheetName).Cells(i,1).Value iDHao = xlApp.WorkSheets(sheetName).Cells(i,2).Value peiFangNeiRong = xlApp.WorkSheets(sheetName).Cells(i,3).Value If Len(peiFangXiangName)<=0 then Exit For End If '循环将数据表的内容导入到配方项 Call RecipeCmd.AddRecipeItem(recipeName,peiFangXiangName,"配方项："&peiFangXiangName) '创建配方项 '导入配方成份值 Call RecipeCmd.SetRecipeItemValue(recipeName,peiFangXiangName,"ID号",IDHao) Call RecipeCmd.SetRecipeItemValue(recipeName,peiFangXiangName,"配方内容",peiFangNeiRong) 配方浏览器0.SaveRecipe() Next xlWorkBook.Save xlWorkBook.Close xlApp.Quit set xlSheet = Nothing set xlWorkBook = Nothing set xlApp = Nothing End If'===================================================End'===================================================S_CSV导入操作If fileExt="csv" then '删除原有的配方项 recipeItemList=RecipeCmd.GetRecipeItemList(recipeName) recipeItemListCount=recipeItemList.Count If recipeItemListCount>0 then For i=0 To recipeItemListCount-1 recipeItemName=recipeItemList(i) Call RecipeCmd.RemoveRecipeItem(RecipeName,recipeItemName) Next End If Const ForReading = 1 Dim csvFSO, csvFile, strline,lineCount lineCount=0 Set csvFSO = nothing Set csvFSO = CreateObject("Scripting.FileSystemObject") Set csvFile = csvFSO.OpenTextFile(filePath, ForReading) Do While csvFile.AtEndOfStream<>True If lineCount>0 then strline=csvFile.readline strlineArray=Split(strline,",",-1,1) If UBound(strlineArray)>0 then peiFangXiangName = strlineArray(0) iDHao = strlineArray(1) peiFangNeiRong = strlineArray(2) '循环将数据表的内容导入到配方项 Call RecipeCmd.AddRecipeItem(recipeName,peiFangXiangName,"配方项："&peiFangXiangName) '创建配方项 '导入配方成份值 Call RecipeCmd.SetRecipeItemValue(recipeName,peiFangXiangName,"ID号",IDHao) Call RecipeCmd.SetRecipeItemValue(recipeName,peiFangXiangName,"配方内容",peiFangNeiRong) 配方浏览器0.SaveRecipe() End If End If lineCount=lineCount+1 Loop csvFile.close Set csvFSO = nothing End If'===================================================EndMsgBox "导入成功"
5、导出按钮 左键按下 事件：Dim sltTypeConst ForWriting = 8Dim objFSO, objFile, strline,strWrite荑樊综鲶,sheetName Dim RecipeNameSet objFSO = CreateObject("Scripting.FileSystemObject")RecipeName="Recipe.板件"sheetName="板件"sltType=组合框0.SelectedIndex'===================================================S_导出CSVIf sltType=0 then newFileName= "配方"&Sys.Year&Sys.Month&Sys.Day&"_"&Sys.Hour&Sys.Minute&Sys.Second&Sys.Millisecond filePath=Sys.ProjectDir & "\DataFiles\"&newFileName&".csv" '判断文件是否存在，不存在则创建文件 If not objFSO.fileExists(filePath) then Call objFSO.CreateTextFile(filePath,True) End If '写入csv文本内容 Set objFile = objFSO.OpenTextFile(filePath, ForWriting,false) '获取配方项的值 recipeItemList= RecipeCmd.GetRecipeItemList(RecipeName) recipeItemListCount=recipeItemList.Count strRecipeItem="配方项," '获取配方成分 recipeElList= RecipeCmd.GetRecipeElementList(RecipeName) recipeElListCount=recipeElList.count '组装首行 For j=0 To recipeElListCount-1 recipeElValue=recipeElList(j) strRecipeItem=strRecipeItem&recipeElValue&"," Next strRecipeItem=Left(strRecipeItem,Len(strRecipeItem)-1) objFile.WriteLine(strRecipeItem) '组装数据行 For i=0 To recipeItemListCount-1 dataROW="" chengfenRow="" peifangxiangName=recipeItemList(i) dataROW=dataROW&peifangxiangName&"," For k=0 To recipeElListCount-1 chengfenValue=RecipeCmd.GetRecipeItemValue(RecipeName,peifangxiangName,recipeElList(k)) chengfenRow=chengfenRow&chengfenValue&"," Next dataROW=dataROW&chengfenRow dataROW=Left(dataROW,Len(dataROW)-1) objFile.WriteLine(dataROW) Next objFile.close Set fso = nothing End If'===================================================End'===================================================S_导出ExcelIf sltType=1 then filePath=Sys.ProjectDir & "\DataFiles\TplPeiFangExport.xlsx" '如果文件不存在创建文件 If not objFSO.fileExists(filePath) then MsgBox "模板文件不存在" Exit Sub End If newFileName= "配方"&Sys.Year&Sys.Month&Sys.Day&"_"&Sys.Hour&Sys.Minute&Sys.Second&Sys.Millisecond newFilePath=Sys.ProjectDir & "\DataFiles\"&newFileName&".xlsx" objFSO.CopyFile filePath,newFilePath,False Set objFSO = nothing '写入Excel dim xlApp,xlWorkBook,xlSheet dim iRowCount,iLoop,numAdd set xlApp = CreateObject("Excel.Application") xlApp.Visible = false set xlWorkBook = xlApp.Workbooks.Open(newFilePath) set xlSheet = xlWorkBook.Sheets(sheetName) '读取配方_项数据 recipeItemList=RecipeCmd.GetRecipeItemList(RecipeName) recipeItemListCount=recipeItemList.Count '读取配方_成分 recipeElementList=RecipeCmd.GetRecipeElementList(RecipeName) recipeElementListCount=recipeElementList.Count '循环写入配方项 If CInt(recipeItemListCount)>0 then For i=0 To recipeItemListCount-1 '配方项 recipeItemValue=recipeItemList(i) xlApp.cells(i+2,1)=recipeItemValue Next End If '配方成份值 If CInt(recipeItemListCount)>0 then For k=0 To recipeItemListCount-1 recipeItemValue=recipeItemList(k)'配方项 If CInt(recipeElementListCount)>0 then For l=0 To recipeElementListCount-1 recipeElmentName=recipeElementList(l) recipeElementValue=RecipeCmd.GetRecipeItemValue(RecipeName,recipeItemValue,recipeElmentName) xlApp.cells(k+2,l+2)=recipeElementValue Next End If Next End If xlWorkBook.Save xlWorkBook.Close xlApp.Quit set xlSheet = Nothing set xlWorkBook = Nothing set xlApp = Nothing End If'===================================================EndMsgBox "导出成功"
6、查询按钮 左召堡厥熠键按下事件：recipNmae="Recipe.板件"recipItemName=""inpputValu髫潋啜缅e=文本框0.TextrecipeItemList=RecipeCmd.GetRecipeItemList(recipNmae)For i=0 To recipeItemList.Count-1 recipeItemVlue=recipeItemList(i) 'MsgBox recipeItemVlue '比对值 valueStr=RecipeCmd.GetRecipeItemValue(recipNmae,recipNmae&"."&recipeItemVlue,recipNmae&".ID号") If (CStr(inpputValue) = CStr(valueStr)) then recipItemName=recipeItemVlue End IfNextCall RecipeCmd.LoadRecipeItem(recipNmae,recipItemName)
7、查询按钮 左键抬起事件：文本框0.Text=""文本框0.Focus()文本框0.SelectAll()
8、变量相关创建如下图
9、窗口设计相关的属性和关联变量：1、组合框【图1】2、ID号文本框【图2】3、配方内容 文本框【图3】
