先來看下運作效果:
以下是實作步驟:
第一步:設計界面,參考上面的運作時設計界面即可;
第二步:建立DataFiles檔案,用于存放導入導出的Excel或Csv模闆來使用的
1、DataFiles檔案夾裡主要包含三個檔案 TplPeiFang.csv(需要導入的CSV模闆格式)、TplPeiFang.xlsx(需要導入的Excel模闆格式)、TplPeiFangExport.xlsx(導出Excel需要被複制的模闆)。注意:模闆格式必須要按照這種格式
上圖為TplPeiFang.csv 和 TplPeiFang.xlsx的格式
上圖為TplPeiFangExport.xlsx 模闆格式
第三步:視窗設計相關的腳本事件
1、導入按鈕 左鍵按下 事件
Dim errorDes1,errorDes2,errorTitle
Dim fileExtArray,fileName,filePath,fileExt,fileExtIsTrue,fileNameSplitArray
fileExtIsTrue=False
filePath=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 Sub
End If
fileNameSplitArray=Split(fileName,".",-1,1)
'判斷檔案格式 為 xxxx.xxx
If UBound(fileNameSplitArray)<>1 then
MsgBox errorDes2,0,errorTitle
Exit Sub
End If
'判斷檔案格式隻支援 csv,xlsx,xls
fileExt=LCase(Trim(fileNameSplitArray(1)))'去除左右兩邊空格,并将大寫字母轉換成小寫字母
For i=0 To UBound(fileExtArray)
If fileExt=fileExtArray(i) then
fileExtIsTrue=True
Exit For
End If
Next
If fileExtIsTrue=False then
MsgBox errorDes2,0,errorTitle
Exit Sub
End If
'判斷模闆檔案是否存在
Set objFSO = CreateObject("Scripting.FileSystemObject")
filePath=filePath & fileName
If not objFSO.fileExists(filePath) then
MsgBox errorDes3,0,errorTitle
Exit Sub
End If
Set objFSO = nothing
'===================================================End
Dim recipeItemList,recipeItemListCount,peiFangXiangName
Dim recipeName,sheetName
Dim iDHao,peiFangNeiRong
recipeName="闆件"
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
'===================================================End
MsgBox "導入成功"
2、導出按鈕 左鍵按下 事件
Dim sltType
Const ForWriting = 8
Dim objFSO, objFile, strline,strWrite,sheetName
Dim RecipeName
Set objFSO = CreateObject("Scripting.FileSystemObject")
RecipeName="Recipe.闆件"
sheetName="闆件"
sltType=組合框0.SelectedIndex
'===================================================S_導出CSV
If 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_導出Excel
If 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
'===================================================End
MsgBox "導出成功"
3、查詢按鈕 左鍵按下事件
recipNmae="Recipe.闆件"
recipItemName=""
inpputValue=文本框0.Text
recipeItemList=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 If
Next
Call RecipeCmd.LoadRecipeItem(recipNmae,recipItemName)
查詢按鈕 左鍵擡起事件
文本框0.Text=""
文本框0.Focus()
文本框0.SelectAll()
第四步:變量相關建立
第五步:視窗設計相關的屬性和關聯變量
1、組合框
2、ID号文本框
3、配方内容 文本框