kobo

建議請將檔案上傳,把您的問題說清楚

sayloveme

回復 9#、10#

先謝謝大大們，補齊上述所需之資料~如下所示：

Sub CreateFile_Click()
'"建檔"功能
Dim I, J As Long
'
  
  UserForm1.Hide
'認證
Call admit(adm)
    If adm = 2 Then
         MsgBox "您的巨集尚未更新，請去O槽將巨集更新"
         Exit Sub
    End If
'--------------
  
  YS = YS_Y & " 年 " & YS_S
  WestYS1 = CLng(1910 + CLng(YS_Y))
  WestYS2 = CLng(1912 + CLng(YS_Y))
  
'
  Filename = UCase(FacNo.Text) & "_" & GetSsn(YS)
   If CLng(YS_Y) > 95 Then '加入96年新表單
    lsExcelModel = lsExcelFilePath & "96年試算表.xls"
   Else
    lsExcelModel = lsExcelFilePath & "試算表.xls"
   End If
  Workbooks.Open Filename:=lsExcelModel
  Sheets.Add After:=Worksheets(Worksheets.Count)
  Sheets(ActiveCell.Worksheet.Name).Select
  Sheets(ActiveCell.Worksheet.Name).Name = "匯入"
      Columns("A:AZ").Select
      Selection.NumberFormatLocal = "@"
  ActiveWorkbook.SaveAs Filename:=lsExcelFilePath & "建檔資料\" & Filename & ".xls" '存檔路徑
'----------------------------------------------------取出資料
  EmptyRowIndex = GetEmptyRowIndex("匯入")
  Cells(EmptyRowIndex, 3).Value = "#" & "P_Factory" & "#" '工廠基本資料
  SQLStr = "SELECT P_Factory.* FROM P_Factory WHERE (((P_Factory.管制編號)='" & FacNo & "'))"
  Call GetDataFromDB(lsDBFilePathName, SQLStr, EmptyRowIndex + 1, "Yes")


If CLng(YS_Y) <= 95 Then '95年前匯入檔案功能
'
  EmptyRowIndex = GetEmptyRowIndex("匯入")
  Cells(EmptyRowIndex, 3).Value = "#" & "P_Exp" & "#" '申報書登載資料
  SQLStr = "SELECT P_Exp.* FROM P_Exp RIGHT JOIN P_Factory ON P_Exp.R_P_FTsn = P_Factory.P_FTsn "
  SQLStr = SQLStr & "WHERE (((P_Factory.管制編號)='" & FacNo & "') AND ((P_Exp.年度季別)='" & GetSsn(YS) & "')) ORDER BY P_Exp.R_P_FTsn, P_Exp.年度季別, P_Exp.補件"
  Call GetDataFromDB(lsDBFilePathName, SQLStr, EmptyRowIndex + 1, "Yes")
'
  EmptyRowIndex = GetEmptyRowIndex("匯入")
  Cells(EmptyRowIndex, 3).Value = "#" & "P_Exp_Pipe_0" & "#" '申報資料,P_Exp_Pipe_0
  SQLStr = "SELECT P_Exp_Pipe_0.* "
  SQLStr = SQLStr & "FROM P_Factory LEFT JOIN (P_Exp LEFT JOIN P_Exp_Pipe_0 ON P_Exp.PESn = P_Exp_Pipe_0.R_PEsn) ON P_Factory.P_FTsn = P_Exp.R_P_FTsn "
  SQLStr = SQLStr & "WHERE (((P_Factory.管制編號)='" & FacNo & "') AND ((P_Exp.年度季別)='" & GetSsn(YS) & "') AND ((P_Exp_Pipe_0.R_PEsn) Is Not Null)) "
  SQLStr = SQLStr & "ORDER BY P_Exp_Pipe_0.煙道編號, P_Exp_Pipe_0.污染源編號, P_Exp_Pipe_0.月份"
  Call GetDataFromDB(lsDBFilePathName, SQLStr, EmptyRowIndex + 1, "Yes")
'
  EmptyRowIndex = GetEmptyRowIndex("匯入")
  Cells(EmptyRowIndex, 3).Value = "#" & "P_Exp_Pipe_1" & "#" '初審資料
  SQLStr = "SELECT P_Exp_Pipe_1.* "
  SQLStr = SQLStr & "FROM P_Factory LEFT JOIN (P_Exp LEFT JOIN P_Exp_Pipe_1 ON P_Exp.PESn = P_Exp_Pipe_1.R_PEsn) ON P_Factory.P_FTsn = P_Exp.R_P_FTsn "
  SQLStr = SQLStr & "WHERE (((P_Factory.管制編號)='" & FacNo & "') AND ((P_Exp.年度季別)='" & GetSsn(YS) & "') AND ((P_Exp_Pipe_1.R_PEsn) Is Not Null)) "
  SQLStr = SQLStr & "ORDER BY P_Exp_Pipe_1.煙道編號, P_Exp_Pipe_1.污染源編號, P_Exp_Pipe_1.月份"
  Call GetDataFromDB(lsDBFilePathName, SQLStr, EmptyRowIndex + 1, "Yes")
'
Else '96年匯入檔案
  EmptyRowIndex = GetEmptyRowIndex("匯入")
  Cells(EmptyRowIndex, 3).Value = "#" & "applyusersend" & "#" '申報書登載資料
  SQLStr = "SELECT applyusersend.* FROM applyusersend "
  SQLStr = SQLStr & "WHERE (((applyusersend.管制編號)='" & FacNo & "') AND ((applyusersend.年度季別)='" & GetSsn(YS) & "'))"
  Call GetDataFromDB(lsDBFilePathName, SQLStr, EmptyRowIndex + 1, "Yes")

  EmptyRowIndex = GetEmptyRowIndex("匯入")
  Cells(EmptyRowIndex, 3).Value = "#" & "chimneyapply" & "#" '申報資料
  SQLStr = "SELECT chimneyapply.* FROM chimneyapply "
  SQLStr = SQLStr & "WHERE (((chimneyapply.管制編號)='" & FacNo & "') AND ((chimneyapply.年度季別)='" & GetSsn(YS) & "'))"
  SQLStr = SQLStr & "ORDER BY chimneyapply.煙道編號, chimneyapply.污染源編號, chimneyapply.月份"
  Call GetDataFromDB(lsDBFilePathName, SQLStr, EmptyRowIndex + 1, "Yes")

End If

'kuo add start 94/5/24
  EmptyRowIndex = GetEmptyRowIndex("匯入")
  Cells(EmptyRowIndex, 3).Value = "#" & "X_ExpRep" & "#" '
  SQLStr = "SELECT DISTINCT X_ExpRep.* "
  SQLStr = SQLStr & "FROM X_ExpRep LEFT JOIN X_ExpRepPol ON (X_ExpRep.XERPFTFacNo = X_ExpRepPol.XRPPFTFacNo) AND (X_ExpRep.XERMEREquipNo = X_ExpRepPol.XRPMEREquipNoP) AND (X_ExpRep.XERSDate = X_ExpRepPol.XRPSDate) AND (X_ExpRep.XEROrder = X_ExpRepPol.XRPOrder) AND (X_ExpRep.XERPosition = X_ExpRepPol.XRPPosition) AND (X_ExpRep.XERFlag = X_ExpRepPol.XRPFlag) "
  SQLStr = SQLStr & "WHERE (((X_ExpRepPol.XRPCPOName)='硫氧化物' Or (X_ExpRepPol.XRPCPOName)='氮氧化物') AND ((X_ExpRep.XERPFTFacNo)='" & FacNo & "') AND ((Year([XERSDate])) >=" & WestYS1 & ") AND ((Year([XERSDate])) <=" & WestYS2 & "))"
  Call GetDataFromDB(lsExpDBFilePathName, SQLStr, EmptyRowIndex + 1, "Yes")
'
  -待續

sayloveme

EmptyRowIndex = GetEmptyRowIndex("匯入")
  Cells(EmptyRowIndex, 3).Value = "#" & "X_ExpRepPol" & "#" '
  SQLStr = "SELECT X_ExpRepPol.* FROM X_ExpRepPol "
  SQLStr = SQLStr & "WHERE (((X_ExpRepPol.XRPPFTFacNo)='" & FacNo & "') AND ((X_ExpRepPol.XRPCPOName)='硫氧化物') AND ((Year([XRPSDate]))>=" & WestYS1 & ")) OR (((X_ExpRepPol.XRPPFTFacNo)='" & FacNo & "') AND ((X_ExpRepPol.XRPCPOName)='氮氧化物') AND ((Year([XRPSDate]))>=" & WestYS1 & "))"
  Call GetDataFromDB(lsExpDBFilePathName, SQLStr, EmptyRowIndex + 1, "Yes")
'
  EmptyRowIndex = GetEmptyRowIndex("匯入")
  Cells(EmptyRowIndex, 3).Value = "#" & "X_ExpCtl" & "#" '
  SQLStr = "SELECT X_ExpCtl.* FROM X_ExpCtl WHERE (((X_ExpCtl.XECPFTFacNo)='" & FacNo & "') AND ((Year([XECSDate]))>=" & WestYS1 & "))"
  Call GetDataFromDB(lsExpDBFilePathName, SQLStr, EmptyRowIndex + 1, "Yes")
'
  EmptyRowIndex = GetEmptyRowIndex("匯入")
  Cells(EmptyRowIndex, 3).Value = "#" & "X_ExpCtlPol" & "#" '
  SQLStr = "SELECT X_ExpCtlPol.* FROM X_ExpCtlPol WHERE (((X_ExpCtlPol.XCPPFTFacNo)='" & FacNo & "') AND ((X_ExpCtlPol.XCPCPOName)='硫氧化物') AND ((Year([XCPSDate]))>=" & WestYS1 & ")) OR (((X_ExpCtlPol.XCPPFTFacNo)='" & FacNo & "') AND ((X_ExpCtlPol.XCPCPOName)='氮氧化物') AND ((Year([XCPSDate]))>=" & WestYS1 & "))"
  Call GetDataFromDB(lsExpDBFilePathName, SQLStr, EmptyRowIndex + 1, "Yes")
'
  EmptyRowIndex = GetEmptyRowIndex("匯入")
  Cells(EmptyRowIndex, 3).Value = "#" & "X_ExpRepReq" & "#" '
  SQLStr = "SELECT X_ExpRepReq.* "
  SQLStr = SQLStr & "FROM X_ExpRep LEFT JOIN X_ExpRepReq ON (X_ExpRep.XERMEREquipNo = X_ExpRepReq.XRRMEREquipNoP) AND (X_ExpRep.XERFlag = X_ExpRepReq.XRRFlag) AND (X_ExpRep.XERPosition = X_ExpRepReq.XRRPosition) AND (X_ExpRep.XEROrder = X_ExpRepReq.XRROrder) AND (X_ExpRep.XERSDate = X_ExpRepReq.XRRSDate) AND (X_ExpRep.XERPFTFacNo = X_ExpRepReq.XRRPFTFacNo) "
  SQLStr = SQLStr & "WHERE (((X_ExpRepReq.XRRSn) Is Not Null) AND ((Year([XERSDate]))>=" & WestYS1 & ") AND ((X_ExpRep.XERPFTFacNo)='" & FacNo & "') AND ((X_ExpRepReq.XRRKind)<3)) "
  SQLStr = SQLStr & "ORDER BY X_ExpRep.XERMEREquipNo, X_ExpRep.XERSDate, X_ExpRep.XEROrder, X_ExpRepReq.XRRSn"
  Call GetDataFromDB(lsExpDBFilePathName, SQLStr, EmptyRowIndex + 1, "Yes")
'
  EmptyRowIndex = GetEmptyRowIndex("匯入")
  Cells(EmptyRowIndex, 3).Value = "#" & "X_ExpRepAgt" & "#" '
  SQLStr = "SELECT X_ExpRepAgt.* "
  SQLStr = SQLStr & "FROM X_ExpRep LEFT JOIN X_ExpRepAgt ON (X_ExpRep.XERFlag = X_ExpRepAgt.XRAFlag) AND (X_ExpRep.XERPosition = X_ExpRepAgt.XRAPosition) AND (X_ExpRep.XEROrder = X_ExpRepAgt.XRAOrder) AND (X_ExpRep.XERSDate = X_ExpRepAgt.XRASDate) AND (X_ExpRep.XERMEREquipNo = X_ExpRepAgt.XRAMEREquipNoP) AND (X_ExpRep.XERPFTFacNo = X_ExpRepAgt.XRAPFTFacNo) "
  SQLStr = SQLStr & "WHERE (((X_ExpRepAgt.XRASn) Is Not Null) AND ((X_ExpRep.XERPFTFacNo)='" & FacNo & "') AND (Year([XERSDate])>2002)) "
  SQLStr = SQLStr & "ORDER BY  X_ExpRepAgt.XRASn"
  Call GetDataFromDB(lsExpDBFilePathName, SQLStr, EmptyRowIndex + 1, "No")


'
  EmptyRowIndex = GetEmptyRowIndex("匯入")
  Cells(EmptyRowIndex, 3).Value = "#" & "End" & "#"
'----------------------------------------------------求取P_FactoryStartRowNbr,P_FactoryCount,P_FactoryFieldCount
Call GetIndex("匯入", "P_Factory")
If CLng(YS_Y) <= 95 Then '95年匯入功能
Call GetIndex("匯入", "P_Exp")
Call GetIndex("匯入", "P_Exp_Pipe_0")
Call GetIndex("匯入", "P_Exp_Pipe_1")
Else
Call GetIndex("匯入", "applyusersend")
Call GetIndex("匯入", "chimneyapply")
End If

Call GetIndex("匯入", "X_ExpRep")
Call GetIndex("匯入", "X_ExpRepPol")
Call GetIndex("匯入", "X_ExpCtl")
Call GetIndex("匯入", "X_ExpCtlPol")
Call GetIndex("匯入", "X_ExpRepReq")
Call GetIndex("匯入", "X_ExpRepAgt")
Call GetIndex("匯入", "End")
'
If P_FactoryCount = 0 Then
MsgBox "在P_Factory中,找不到資料,無法繼續執行"
Exit Sub
End If
If P_FactoryCount > 1 Then
MsgBox "在P_Factory中,資料大於1筆,無法繼續執行"
Exit Sub
End If
'配合961季修正
'If P_ExpCount = 0 Then
'MsgBox "在P_Exp中,找不到資料,無法繼續執行"
'Exit Sub
'End If
'If P_Exp_Pipe_0Count = 0 Then
'MsgBox "在申報中,找不到資料,無法繼續執行"
'Exit Sub
'End If
'改成無初審資料也可審查
'If P_Exp_Pipe_1Count = 0 Then
'MsgBox "在初審中,找不到資料,無法繼續執行"
'Exit Sub
'End If
'----------------------------------------------------填入資料
  Call Filldata
'----------------------------------------------------
'
ActiveWorkbook.Save '存檔
End Sub
-----------------------------------------------------------------------我是分隔線--------

拜託各位大大，求解為何我輸入是99年時，存檔的型態是檔名_099X，其中X是分為4季，但當我是輸入100年時，存檔卻是檔名_010，無法顯示季別。
YS = YS_Y & " 年 " & YS_S   
YS_Y 為年度季別、YS_S 為季別

先謝謝各位!! 謝謝大家

GBKEE

回復 13# sayloveme
但當我是輸入100年時，存檔卻是檔名_010，無法顯示季別。
變數不要設與關鍵字相同
ActiveWorkbook.SaveAs Filename:=lsExcelFilePath & "建檔資料\" & Filename & ".xls" '存檔路徑
存檔檔名 ->  Filename = UCase(FacNo.Text) & "_" & GetSsn(YS)  ->   FacNo.Text   ,  GetSsn(YS)  它的(字串,值) 不知道
你上傳了一堆程式碼 還是片段  11# 不是建議請將檔案上傳,把您的問題說清楚

kobo

看到您貼上來的程式碼,作者應是對程式語言具有相當的功力,
研判您是想延用此一檔案與程序,建議您直接與作者連繫,以解決您的問題
或是將整個excel檔案上傳尋求解答

sayloveme

回復 14#、15#

先謝謝兩位大大的解釋，的確此版本是經由本公司人員寫出，但由於總公司人員在台北，而我們目前在高雄，加上此版早在民國90年左右就有了，
加上前後不少人員更新過版本且年代久遠，我也無法了解這當中某些字串是否與當時檔案有相關連結，人員的變動加上檔案久遠，加上我並非專業本科出身，
可能造成各位麻煩，在此向大家說聲抱歉。

檔案方面，我也不方便上傳，不管如何，我從中獲取不少知識，先謝謝大家。謝謝!!