Access作为数据库，保存数据，并通过窗体来录入，查询和导出数据；
Option Compare Database Function TableDelete(strName As String) CurrentDb.Execute "Delete * from " & strName & ";" End Function Function QueryRunDingdan(strName As String) CurrentDb.Execute "INSERT INTO I_Dingdan ( 商品编码, 品名, 规格, 入箱数, 单位, 物料代码, 箱规（外）, 单价, 净重, 毛重, 保质期, 化验台账 ) SELECT I_Base.商品编码, I_Base.商品名称, I_Base.商品规格, I_Base.入箱数, I_Base.单位, I_Base.物料代码, I_Base.外纸箱规格, I_Base.单价, I_Base.[净重/kg], I_Base.[毛重/kg], I_Base.[保质期/月], I_Base.化验台账 FROM I_Base WHERE (((I_Base.客戸名称)=""" & strName & """));" End Function Function QueryRunChuKouDingdan() CurrentDb.Execute "INSERT INTO E_Dingdan ( 製品*, 製品名, 製品名_英, 製品名_日, 规格, 单位, 单价, 通貨, 入箱数, [賞味期限/月], NW, GW, 体积, 外纸箱规格, 単価単位 ) " & _ "SELECT E_Base.商品*, E_Base.商品名称_中, E_Base.商品名称_英, E_Base.商品名称_日, E_Base.商品规格, E_Base.单位, E_Base.单价, E_Base.通貨, E_Base.入箱数, E_Base.[賞味期限/月], E_Base.NW, E_Base.GW, E_Base.体积, E_Base.外纸箱规格, E_Base.单位2 " & _ "FROM I_Customer INNER JOIN E_Base ON I_Customer.客戸名称 = E_Base.客戸 WHERE (((I_Customer.编号)=‘" & [Forms]![出口受注订单]![客户名称] & "‘));" End Function Function CalXiangshuAndShuliang() If Forms("国内受注订单").[入箱数] > 0 Then If Forms("国内受注订单").[箱数] >= 0 Then Forms("国内受注订单").[数量] = Forms("国内受注订单").[箱数] * Forms("国内受注订单").[入箱数] ElseIf Forms("国内受注订单").[数量] >= 0 Then Forms("国内受注订单").[箱数] = Forms("国内受注订单").[数量] / Forms("国内受注订单").[入箱数] End If End If If Forms("国内受注订单").[数量] > 0 And Forms("国内受注订单").[单价] > 0 Then Forms("国内受注订单").[金额] = Forms("国内受注订单").[数量] * Forms("国内受注订单").[单价] End If End Function Function CalNapin() If Forms("国内売上詳細").[订单数量] > 0 Then If Forms("国内売上詳細").[納品数] >= 0 Then Forms("国内売上詳細").[未納品数] = Forms("国内売上詳細").[订单数量] - Forms("国内売上詳細").[納品数] ElseIf Forms("国内売上詳細").[未納品数] >= 0 Then Forms("国内売上詳細").[納品数] = Forms("国内売上詳細").[订单数量] - Forms("国内売上詳細").[未納品数] End If End If End Function Function CopyDingdanGuonei() If IsNull(Forms("国内受注订单").[订单*]) Or IsNull(Forms("国内受注订单").[客户名称选择]) Or IsNull(Forms("国内受注订单").[日期]) Then MsgBox "信息缺失" Else temSQL = "INSERT INTO I_Detail ( 商品编码, [品 名], [规 格], 箱数, [单 位], 订单数量, 订单交期, 回复交期, [单 价], [金 额], 入箱数, 物料代码, 保质期, 化验台账, 箱规（外）, " & _ "[净重/kg], [毛重/kg], 胶带颜色, 客户名称, 订单*, 受注日期 ) SELECT I_Dingdan.商品编码, I_Dingdan.品名, I_Dingdan.规格, I_Dingdan.箱数, I_Dingdan.单位, I_Dingdan.数量, " & _ "I_Dingdan.订单交期, I_Dingdan.回复交期, I_Dingdan.单价, I_Dingdan.金额, I_Dingdan.入箱数, I_Dingdan.物料代码, I_Dingdan.保质期, I_Dingdan.化验台账, I_Dingdan.箱规（外）, " & _ "I_Dingdan.净重, I_Dingdan.毛重, I_Dingdan.胶带颜色, """ & [Forms]![国内受注订单]![客户名称选择] & """ AS 客户名称, """ & [Forms]![国内受注订单]![订单*] & """ AS 订单*, """ & _ [Forms]![国内受注订单]![日期] & """ AS 日期 FROM I_Dingdan WHERE (((I_Dingdan.箱数)>0)) OR (((I_Dingdan.数量)>0));" ‘ Debug.Print temSQL CurrentDb.Execute temSQL End If End Function Function CalXiangshuAndShuliangChuKou() If Forms("出口受注订单").[入箱数] > 0 Then If Forms("出口受注订单").[箱数] >= 0 Then Forms("出口受注订单").[数量] = Forms("出口受注订单").[箱数] * Forms("出口受注订单").[入箱数] ElseIf Forms("出口受注订单").[数量] >= 0 Then Forms("出口受注订单").[箱数] = Forms("出口受注订单").[数量] / Forms("出口受注订单").[入箱数] End If End If If Forms("出口受注订单").[単価単位] = "／ＣＴ" Then If Forms("出口受注订单").[箱数] > 0 And Forms("出口受注订单").[单价] > 0 Then Forms("出口受注订单").[金额] = Forms("出口受注订单").[箱数] * Forms("出口受注订单").[单价] End If Else If Forms("出口受注订单").[数量] > 0 And Forms("出口受注订单").[单价] > 0 Then Forms("出口受注订单").[金额] = Forms("出口受注订单").[数量] * Forms("出口受注订单").[单价] End If End If End Function Function CalNapinChuKou() If Forms("出口売上詳細").[数量] > 0 Then If Forms("出口売上詳細").[出荷数] >= 0 Then Forms("出口売上詳細").[未納品数] = Forms("出口売上詳細").[数量] - Forms("出口売上詳細").[出荷数] ElseIf Forms("出口売上詳細").[未納品数] >= 0 Then Forms("出口売上詳細").[出荷数] = Forms("出口売上詳細").[数量] - Forms("出口売上詳細").[未納品数] End If End If End Function Function CopyDingdanChuKou() If IsNull(Forms("出口受注订单").[订单*]) Or IsNull(Forms("出口受注订单").[客户名称]) Or IsNull(Forms("出口受注订单").[日期]) Then MsgBox "信息缺失" Else temSQL = "INSERT INTO E_Detail ( ユーザー名, 契約*, 受注日付, 受注*, *, 製品名, 製品名（英）, 製品名（日）, 规格, 箱数, 単位, 数量, 通貨, 入箱数, コンテナ積, 出港日, 入港日, 入港口, 貿易方式, [賞味期限/月], 体积, 外纸箱规格 ) " & _ "SELECT ‘" & Forms("出口受注订单").[客户名称] & "‘ AS A, ‘" & Forms("出口受注订单").[订单*] & "‘AS B,‘" & Forms("出口受注订单").[日期] & "‘ AS C, E_Dingdan.注文*, E_Dingdan.製品*, E_Dingdan.製品名, E_Dingdan.製品名_英, E_Dingdan.製品名_日, E_Dingdan.规格, E_Dingdan.箱数, E_Dingdan.单位, E_Dingdan.数量, " & _ "E_Dingdan.通貨, E_Dingdan.入箱数, E_Dingdan.コンテナ積, E_Dingdan.出港日, E_Dingdan.入港日, E_Dingdan.入港口, E_Dingdan.貿易方式, E_Dingdan.[賞味期限/月], E_Dingdan.体积, E_Dingdan.外纸箱规格 FROM E_Dingdan WHERE (((E_Dingdan.箱数)>0)) OR (((E_Dingdan.数量)>0));" ‘ Debug.Print temSQL CurrentDb.Execute temSQL End If End Function Function guoneiweishengchan() Dim temRan As Worksheet On Error GoTo Errprocessing excel.Application.DisplayAlerts = False excel.Application.ScreenUpdating = False strSql = "SELECT IIf(IsNull([编号]),[客戸名称],[编号]) AS 客戸名称2,null as blank, I_Detail.[品 名] AS 产品名称, I_Detail.[规 格], I_Detail.箱数, [订单数量] & [单 位] AS 数量, I_Detail.回复交期 AS 预计发货交期, I_Detail.受注日期, I_Detail.备注, I_Detail.订单* AS 合同号 " & _ "FROM I_Detail LEFT JOIN I_Customer ON I_Detail.客户名称=I_Customer.客戸名称 WHERE (((I_Detail.未納品数)>0)) ORDER BY I_Detail.回复交期,IIf(IsNull([编号]),[客戸名称],[编号]), I_Detail.受注日期;" Set temRan = ExportToExcel(strSql, , , , "国内未出荷明细", "国内未出荷明细" & Format(Date, "yyyymmdd")) Call FExcel.setFormatBorders(temRan.UsedRange) Call FExcel.setFormatWeishengchan(temRan) excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True Exit Function Errprocessing: MsgBox Err.Description excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True End Function Function guoneiTongJiJinE() Dim temRan As Worksheet On Error GoTo Errprocessing excel.Application.DisplayAlerts = False excel.Application.ScreenUpdating = False If Not IsNull([Forms]![国内売上詳細]![发货月份]) Then If MsgBox("是否按月份统计金额？", vbYesNo) = vbYes Then criteriaWhere = "WHERE (((Left([发货日期],7))=‘" & [Forms]![国内売上詳細]![发货月份] & "‘)) " Else criteriaWhere = "" End If Else criteriaWhere = "" End If strSql = "SELECT DISTINCT I_Detail.客户名称, I_Detail.订单*, I_Detail.受注日期, I_Detail.[品 名], I_Detail.[规 格], I_Detail.箱数, I_Detail.订单数量, I_Detail.[单 价], I_Detail.[金 额], I_Detail.納品数, I_Detail.未納品数, I_Detail.发货日期, " & _ "MoneyTotal.[金 额之总计] FROM I_Detail INNER JOIN (SELECT I_Detail.订单*, Sum(I_Detail.[金 额]) AS [金 额之总计] FROM I_Detail GROUP BY I_Detail.订单*) AS MoneyTotal ON I_Detail.订单* = MoneyTotal.订单* " & criteriaWhere & "ORDER BY I_Detail.客户名称, I_Detail.订单*, I_Detail.发货日期;" Set temRan = ExportToExcel(strSql, , 2, 2, "国内统计金额", "国内统计金额" & Format(Date, "yyyymmdd")) Call FExcel.setFormatBorders(temRan.UsedRange) Call FExcel.setFormatTongJiJinE(temRan) excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True Exit Function Errprocessing: MsgBox Err.Description excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True End Function Function guoneiGuoNeiYingShou() Dim temRan As Worksheet On Error GoTo Errprocessing excel.Application.DisplayAlerts = False excel.Application.ScreenUpdating = False If IsNull([Forms]![国内売上詳細]![发货月份]) Then MsgBox "需要选择发货月份；" Exit Function End If strSql = "SELECT FirstQ.客户名称, FirstQ.前期, FirstQ.本月, FirstQ.[品 名], FirstQ.[规 格], FirstQ.[单 位], FirstQ.订单数量, FirstQ.[单 价], FirstQ.[金 额], SecondQ.[金 额之总计], FirstQ.发货月 " & _ "FROM (SELECT DISTINCT I_Detail.客户名称, ‘‘ AS 前期, ‘‘ AS 本月, I_Detail.[品 名], I_Detail.[规 格], I_Detail.[单 位], I_Detail.订单数量, I_Detail.[单 价], I_Detail.[金 额], Left([发货日期],7) AS 发货月 " & _ "FROM I_Detail WHERE (((Left([发货日期],7))=‘" & [Forms]![国内売上詳細]![发货月份] & "‘))) AS FirstQ INNER JOIN (SELECT I_Detail.客户名称, Left([发货日期],7) AS 发货月, Sum(I_Detail.[金 额]) AS [金 额之总计] " & _ "FROM I_Detail GROUP BY I_Detail.客户名称, Left([发货日期],7) HAVING (((Left([发货日期],7))=‘" & [Forms]![国内売上詳細]![发货月份] & "‘))) AS SecondQ ON (FirstQ.发货月 = SecondQ.发货月) AND (FirstQ.客户名称 = SecondQ.客户名称) ORDER BY FirstQ.客户名称; " Set temRan = ExportToExcel(strSql, , 4, 1, "应收账款", "应收账款" & Format(Date, "yyyymmdd")) Call FExcel.setFormatGuoNeiYingShou(temRan) Call FExcel.setFormatBorders(temRan.UsedRange) excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True Exit Function Errprocessing: MsgBox Err.Description excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True End Function Function guoneiGuoNeiYueXiaoShouHuizong() Dim temRan As Worksheet On Error GoTo Errprocessing excel.Application.ScreenUpdating = False excel.Application.DisplayAlerts = False If IsNull([Forms]![国内売上詳細]![发货月份]) Then MsgBox "需要选择发货月份；" Exit Function End If strSql = "SELECT I_Detail.[品 名], I_Detail.[规 格], I_Detail.[单 位], Sum(I_Detail.订单数量) AS 订单数量之总计, ‘‘ AS 样品, ‘‘ AS 赠品, Sum(I_Detail.[金 额]) AS [金 额之总计], Left([发货日期],7) AS 发货月 " & _ "FROM I_Detail GROUP BY I_Detail.[品 名], I_Detail.[规 格], I_Detail.[单 位], ‘‘, ‘‘, Left([发货日期],7) HAVING (((Left([发货日期],7))=‘" & [Forms]![国内売上詳細]![发货月份] & "‘)) ORDER BY I_Detail.[品 名];" Set temRan = ExportToExcel(strSql, , 3, 2, "月销售汇总", "月销售汇总" & Format(Date, "yyyymmdd_" & [Forms]![国内売上詳細]![发货月份])) Call FExcel.setFormatGuoNeiYueXiaoShouHuizong(temRan) Call FExcel.setFormatBorders(temRan.UsedRange) excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True Exit Function Errprocessing: MsgBox Err.Description excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True End Function Function guoneiGuoNeiYueXiaoShouMingxi() Dim temRan As Worksheet On Error GoTo Errprocessing excel.Application.ScreenUpdating = False excel.Application.DisplayAlerts = False If IsNull([Forms]![国内売上詳細]![发货月份]) Then MsgBox "需要选择发货月份；" Exit Function End If strSql = "SELECT I_Detail.客户名称, I_Detail.发货日期, I_Detail.[品 名], I_Detail.[规 格], I_Detail.[单 位], Sum(I_Detail.订单数量) AS 订单数量之总计, I_Detail.[单 价], Sum(I_Detail.[金 额]) AS [金 额之总计], Left([发货日期],7) AS 发货月 " & _ "FROM I_Detail GROUP BY I_Detail.客户名称, I_Detail.发货日期, I_Detail.[品 名], I_Detail.[规 格], I_Detail.[单 位], I_Detail.[单 价], Left([发货日期],7) HAVING (((Left([发货日期], 7)) = ‘" & [Forms]![国内売上詳細]![发货月份] & "‘)) ORDER BY I_Detail.客户名称, I_Detail.[品 名];" Set temRan = ExportToExcel(strSql, , 3, 1, "销售明细", "销售明细" & Format(Date, "yyyymmdd_" & [Forms]![国内売上詳細]![发货月份])) Call FExcel.setFormatGuoNeiYueXiaoShouMingxi(temRan) Call FExcel.setFormatBorders(temRan.UsedRange) excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True Exit Function Errprocessing: MsgBox Err.Description excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True End Function Function guoneiChuKuPiao() Dim temRan As Worksheet On Error GoTo Errprocessing If IsNull([Forms]![国内売上詳細]![订单号]) Or IsNull([Forms]![国内売上詳細]![出库日期2]) Then MsgBox "需要录入订单号和出库日期；" Exit Function End If excel.Application.DisplayAlerts = False excel.Application.ScreenUpdating = False strSql = "SELECT I_Detail.[品 名], I_Detail.[规 格], I_Detail.箱数, I_Detail.[单 位], I_Detail.订单数量, I_Detail.[单 价], I_Detail.[金 额], I_Detail.客户名称 " & _ "FROM I_Detail WHERE (((I_Detail.订单*)=‘" & [Forms]![国内売上詳細]![订单号] & "‘) AND ((I_Detail.出库日期)=‘" & [Forms]![国内売上詳細]![出库日期2] & "‘));" Set temRan = ExportToExcel(strSql, , 15, 2, "出库票", "出库票" & Format(Date, "yyyymmdd_") & [Forms]![国内売上詳細]![订单号]) temRan.Cells(1, 8) = [Forms]![国内売上詳細]![订单号] temRan.Cells(2, 8) = [Forms]![国内売上詳細]![出库日期2] temRan.Cells(2, 3) = temRan.Cells(15, 9) Call FExcel.setFormatChuKuPiao(temRan) excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True Exit Function Errprocessing: MsgBox Err.Description excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True End Function Function guoneiSuiHuoDan() Dim temRan As Worksheet On Error GoTo Errprocessing If IsNull([Forms]![国内売上詳細]![订单号]) Or IsNull([Forms]![国内売上詳細]![发货日期2]) Then MsgBox "需要录入订单号和发货日期；" Exit Function End If excel.Application.DisplayAlerts = False excel.Application.ScreenUpdating = False strSql = "SELECT DISTINCT I_Detail.物料代码, I_Detail.商品编码, I_Detail.[品 名], I_Detail.[规 格], I_Detail.箱规（外）, I_Detail.箱数, I_Detail.订单数量, I_Detail.[净重/kg], I_Detail.[毛重/kg], I_Detail.生产日期, I_Detail.保质期, " & _ "I_Detail.胶带颜色, I_Detail.客户名称, I_Customer.收件信息, I_Customer.收货联系人, I_Customer.电话, I_Customer.发货备注 " & _ "FROM I_Customer INNER JOIN I_Detail ON I_Customer.客戸名称 = I_Detail.客户名称 WHERE (((I_Detail.订单*)=‘" & [Forms]![国内売上詳細]![订单号] & "‘) AND ((I_Detail.发货日期)=‘" & [Forms]![国内売上詳細]![发货日期2] & "‘));" Set temRan = ExportToExcel(strSql, , 21, 2, "随货单", "随货单" & Format(Date, "yyyymmdd_") & [Forms]![国内売上詳細]![订单号]) temRan.Cells(1, 7) = [Forms]![国内売上詳細]![订单号] temRan.Cells(1, 12) = [Forms]![国内売上詳細]![发货日期2] temRan.Cells(1, 2) = temRan.Cells(21, 14) temRan.Cells(16, 1) = "收货地址:" & temRan.Cells(21, 15) temRan.Cells(17, 1) = "收货人:" & temRan.Cells(21, 16) & " 电话:" & temRan.Cells(21, 17) temRan.Cells(18, 1) = "备注:" & temRan.Cells(21, 18) Call FExcel.setFormatSuiHuoDan(temRan) excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True Exit Function Errprocessing: MsgBox Err.Description excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True End Function Function QueryRunHuaYan() CurrentDb.Execute "INSERT INTO I_Huayan ( 发货日期, 产品名称, [规 格], [数 量], [批 号], 购货者名称, 收货地点, 联系人, [电 话] ) " & _ "SELECT DISTINCT I_Detail.发货日期, I_Detail.[品 名], I_Detail.[规 格], I_Detail.订单数量, I_Detail.生产日期, IIf(IsNull([I_Customer]![编号]),[I_Customer]![客戸名称],[I_Customer]![编号]) AS 表达式1, I_Customer.收件信息, I_Customer.收货联系人, I_Customer.电话 " & _ "FROM I_Customer INNER JOIN I_Detail ON I_Customer.客戸名称 = I_Detail.客户名称 " & _ "WHERE (((I_Detail.发货日期)=‘" & [Forms]![国内売上詳細]![发货日期2] & "‘) AND ((I_Detail.化验台账)=‘※‘) AND ((I_Detail.订单*)=‘" & [Forms]![国内売上詳細]![订单号] & "‘));" End Function Function guoneiSuiHuoDanLijia() Dim temRan As Worksheet On Error GoTo Errprocessing If IsNull([Forms]![国内売上詳細]![订单号]) Or IsNull([Forms]![国内売上詳細]![发货日期2]) Then MsgBox "需要录入订单号和发货日期；" Exit Function End If excel.Application.DisplayAlerts = False excel.Application.ScreenUpdating = False strSql = "SELECT I_Detail.[品 名], I_Detail.商品编码, I_Detail.[规 格], Null AS 空, I_Detail.箱规（外）, I_Detail.箱数, I_Detail.[单 价], I_Detail.订单数量, I_Detail.[金 额], I_Detail.生产日期, I_Detail.保质期, I_Customer.客戸名称" & _ ", I_Customer.收件信息, I_Customer.收货联系人, I_Customer.电话, I_Customer.发货备注 " & _ "FROM I_Customer INNER JOIN I_Detail ON I_Customer.客戸名称 = I_Detail.客户名称 WHERE (((I_Detail.订单*)=‘" & [Forms]![国内売上詳細]![订单号] & "‘) AND ((I_Detail.发货日期)=‘" & [Forms]![国内売上詳細]![发货日期2] & "‘));" Set temRan = ExportToExcel(strSql, , 18, 2, "丽家随货单", "丽家随货单" & Format(Date, "yyyymmdd_") & [Forms]![国内売上詳細]![订单号]) temRan.Cells(2, 10) = [Forms]![国内売上詳細]![订单号] temRan.Cells(3, 12) = [Forms]![国内売上詳細]![发货日期2] temRan.Cells(2, 2) = "TO:" & temRan.Cells(18, 13) temRan.Cells(13, 1) = "收货地址:" & temRan.Cells(18, 14) temRan.Cells(14, 1) = "收货人:" & temRan.Cells(18, 15) & " 电话:" & temRan.Cells(18, 16) temRan.Cells(15, 1) = "备注:" & temRan.Cells(18, 17) Call FExcel.setFormatSuiHuoDanLijia(temRan) excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True Exit Function Errprocessing: MsgBox Err.Description excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True End Function Function chukouWeiChuHeChuGang() Dim temRan As Worksheet Dim temRn As Range On Error GoTo Errprocessing excel.Application.DisplayAlerts = False excel.Application.ScreenUpdating = False strSql = "SELECT E_Detail.通関号, IIf(IsNull([编号]),[客戸名称],[编号]) AS 客户, E_Detail.製品名, E_Detail.规格, E_Detail.箱数, E_Detail.コンテナ積, E_Detail.出港日, E_Detail.入港口, [コンテナ] & ‘ * ‘ & [コンテナ個数] AS A, " & _ "E_Detail.契約*, E_Detail.単価, E_Detail.单位2, E_Detail.貿易方式, E_Detail.備考, E_Detail.生産情報, E_Detail.选别, E_Detail.加工, E_Detail.包装, E_Detail.受注*, I_Customer.颜色 FROM I_Customer INNER JOIN E_Detail ON " & _ "I_Customer.编号 = E_Detail.ユーザー名 WHERE (((E_Detail.未納品数)>0)) ORDER BY E_Detail.出港日, E_Detail.契約*, E_Detail.製品名;" Set temRan = ExportToExcel(strSql, , 3, 1, "未出荷明细 入港日順", "未出荷明细 入港日順" & Format(Date, "yyyymmdd")) temRan.Cells(1, 10) = Format(Date, "yyyy/m/d") Call FExcel.setFormatWeiChuHeChuGang(temRan) Set temRn = temRan.Range(temRan.Cells(3, 1), temRan.Cells(temRan.UsedRange.Rows.Count, temRan.UsedRange.Columns.Count)) Call FExcel.setFormatBorders(temRn) excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True Exit Function Errprocessing: MsgBox Err.Description excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True End Function Function chukouWeiChuHeKeHu() Dim temRan As Worksheet Dim temRn As Range On Error GoTo Errprocessing excel.Application.DisplayAlerts = False excel.Application.ScreenUpdating = False strSql = "SELECT E_Detail.通関号, IIf(IsNull([编号]),[客戸名称],[编号]) AS 客户, E_Detail.製品名, E_Detail.规格, E_Detail.箱数, E_Detail.コンテナ積, E_Detail.出港日, E_Detail.入港口, [コンテナ] & ‘ * ‘ & [コンテナ個数] AS A, " & _ "E_Detail.契約*, E_Detail.単価, E_Detail.单位2, E_Detail.貿易方式, E_Detail.備考, E_Detail.生産情報, E_Detail.选别, E_Detail.加工, E_Detail.包装, E_Detail.受注*, I_Customer.颜色 FROM I_Customer INNER JOIN E_Detail ON " & _ "I_Customer.编号 = E_Detail.ユーザー名 WHERE (((E_Detail.未納品数)>0)) ORDER BY I_Customer.顺序, E_Detail.出港日,E_Detail.契約*, E_Detail.製品名;" Set temRan = ExportToExcel(strSql, , 3, 1, "未出荷明细 客別順", "未出荷明细 客別順" & Format(Date, "yyyymmdd")) temRan.Cells(1, 10) = Format(Date, "yyyy/m/d") Call FExcel.setFormatWeiChuHeKeHu(temRan) Set temRn = temRan.Range(temRan.Cells(3, 1), temRan.Cells(temRan.UsedRange.Rows.Count, temRan.UsedRange.Columns.Count)) Call FExcel.setFormatBorders(temRn) excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True Exit Function Errprocessing: MsgBox Err.Description excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True End Function Function chukouWeiChuHeJingLi() Dim temRan As Worksheet Dim temRn As Range On Error GoTo Errprocessing excel.Application.DisplayAlerts = False excel.Application.ScreenUpdating = False strSql = "SELECT E_Detail.*, E_Detail.製品名（日）, E_Detail.规格, E_Detail.箱数, E_Detail.コンテナ積, E_Detail.出港日, E_Detail.[賞味期限/月], E_Detail.生産情報, E_Detail.入港口, E_Detail.コンテナ, E_Detail.契約*, E_Detail.単価, " & _ "E_Detail.受注*, ‘‘ AS A, ‘‘ AS B, E_Detail.金額, E_Detail.通貨, JinE.金額之总计, E_Detail.选别, E_Detail.加工, E_Detail.包装, IIf(IsNull([编号]),[客戸名称],[编号]) AS 客户 FROM (I_Customer INNER JOIN E_Detail ON I_Customer.编号 " & _ "= E_Detail.ユーザー名) INNER JOIN (SELECT E_Detail.契約*, Sum(E_Detail.金額) AS 金額之总计 FROM E_Detail GROUP BY E_Detail.契約*) AS JinE ON E_Detail.契約* = JinE.契約* WHERE (((E_Detail.未納品数) > 0)) ORDER BY I_Customer.顺序, E_Detail.出港日, E_Detail.契約*, E_Detail.*;" Set temRan = ExportToExcel(strSql, , 6, 1, "未出荷詳細 経理用", "未出荷明细 経理用" & Format(Date, "yyyymmdd")) ‘temRan.Cells(1, 10) = Format(Date, "yyyy/m/d") Call FExcel.setFormatWeiChuHeJingLi(temRan) Set temRn = temRan.Range(temRan.Cells(6, 1), temRan.Cells(temRan.UsedRange.Rows.Count, temRan.UsedRange.Columns.Count)) Call FExcel.setFormatBorders(temRn) excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True Exit Function Errprocessing: MsgBox Err.Description excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True End Function Function chukouTongJiKeHu() Dim temRan As Worksheet Dim temRn As Range On Error GoTo Errprocessing excel.Application.DisplayAlerts = False excel.Application.ScreenUpdating = False strSql = "SELECT IIf(IsNull([编号]),[客戸名称],[编号]) AS 客户, E_Detail.契約*, E_Detail.受注日付, E_Detail.製品名, E_Detail.箱数, E_Detail.数量, E_Detail.単価, E_Detail.金額, E_Detail.通貨, E_Detail.出港日, E_Detail.入港日, " & _ "E_Detail.出荷数, E_Detail.未納品数, JinE.金額之总计,I_Customer.颜色 FROM I_Customer INNER JOIN (E_Detail INNER JOIN (SELECT E_Detail.契約*, Sum(E_Detail.金額) AS 金額之总计 FROM E_Detail GROUP BY E_Detail.契約*) AS JinE ON " & _ "E_Detail.契約* = JinE.契約*) ON I_Customer.编号 = E_Detail.ユーザー名 ORDER BY I_Customer.顺序, E_Detail.契約*, E_Detail.製品名;" Set temRan = ExportToExcel(strSql, , 2, 2, "统计金额 客别顺", "统计金额 客别顺" & Format(Date, "yyyymmdd")) Call FExcel.setFormatTongJiKeHu(temRan) Set temRn = temRan.Range(temRan.Cells(2, 2), temRan.Cells(temRan.UsedRange.Rows.Count, 16)) Call FExcel.setFormatBorders(temRn) excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True Exit Function Errprocessing: MsgBox Err.Description excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True End Function Function chukouJinEXiangXi() Dim temRan As Worksheet Dim temRn As Range On Error GoTo Errprocessing excel.Application.DisplayAlerts = False excel.Application.ScreenUpdating = False If IsNull([Forms]![出口売上詳細]![出港月份]) Then MsgBox "需要选择出港月份；" Exit Function End If strSql = "SELECT IIf(IsNull([编号]),[客戸名称],[编号]) AS 客户, E_Detail.製品名, E_Detail.规格, E_Detail.箱数, E_Detail.数量, E_Detail.単価, E_Detail.単位, E_Detail.金額, E_Detail.通貨, E_Detail.出港日, E_Detail.入港日, E_Detail.契約*, " & _ "JinE.金額之总计, I_Customer.颜色 FROM I_Customer INNER JOIN (E_Detail INNER JOIN (SELECT E_Detail.契約*, Sum(E_Detail.金額) AS 金額之总计 FROM E_Detail GROUP BY E_Detail.契約*) AS JinE ON E_Detail.契約* = JinE.契約*) " & _ "ON I_Customer.编号 = E_Detail.ユーザー名 WHERE (((Left([出港日],7))=‘" & [Forms]![出口売上詳細]![出港月份] & "‘)) ORDER BY I_Customer.顺序, E_Detail.契約*;" Set temRan = ExportToExcel(strSql, , 2, 2, "金額詳細", "金額詳細" & Format(Date, "yyyymmdd")) Call FExcel.setFormatJinEXiangXi(temRan) Set temRn = temRan.Range(temRan.Cells(2, 2), temRan.Cells(temRan.UsedRange.Rows.Count, 15)) Call FExcel.setFormatBorders(temRn) excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True Exit Function Errprocessing: MsgBox Err.Description excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True End Function Function chukouTongJiZhiPin() Dim temRan As Worksheet Dim temRn As Range On Error GoTo Errprocessing excel.Application.DisplayAlerts = False excel.Application.ScreenUpdating = False If IsNull([Forms]![出口売上詳細]![出港月份]) Then MsgBox "需要选择出港月份；" Exit Function End If strSql = "SELECT E_Detail.製品名, E_Detail.规格, E_Detail.単位, E_Detail.単価, E_Detail.通貨, Sum(E_Detail.箱数) AS 箱数之总计, Sum(E_Detail.数量) AS 数量之总计, Sum(E_Detail.金額) AS 金額之总计 " & _ "FROM E_Detail GROUP BY E_Detail.製品名, E_Detail.规格, E_Detail.単位, E_Detail.単価, E_Detail.通貨, Left([出港日],7) HAVING (((Left([出港日],7))=‘" & [Forms]![出口売上詳細]![出港月份] & "‘));" Set temRan = ExportToExcel(strSql, True, , , , "製品別" & Format(Date, "yyyymmdd")) Call FExcel.setFormatTongJiZhiPin(temRan) Set temRn = temRan.Range(temRan.Cells(1, 1), temRan.Cells(temRan.UsedRange.Rows.Count, temRan.UsedRange.Columns.Count)) Call FExcel.setFormatBorders(temRn) excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True Exit Function Errprocessing: MsgBox Err.Description excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True End Function Function chukouTongJiKeHuXiangXi() Dim temRan As Worksheet Dim temRan2 As Worksheet Dim temRn As Range On Error GoTo Errprocessing excel.Application.DisplayAlerts = False excel.Application.ScreenUpdating = False If IsNull([Forms]![出口売上詳細]![出港月份]) Then MsgBox "需要选择出港月份；" Exit Function End If strSql = "SELECT IIf(IsNull([编号]),[客戸名称],[编号]) AS 客户, E_Detail.契約*, E_Detail.受注日付, E_Detail.製品名, E_Detail.箱数, E_Detail.数量, E_Detail.単価, E_Detail.金額, E_Detail.出港日, " & _ "E_Detail.入港日, JinE.金額之总计, E_Detail.通貨, I_Customer.颜色 FROM I_Customer INNER JOIN (E_Detail INNER JOIN (SELECT E_Detail.契約*, Sum(E_Detail.金額) AS 金額之总计 FROM E_Detail GROUP BY " & _ "E_Detail.契約*) AS JinE ON E_Detail.契約* = JinE.契約*) ON I_Customer.编号 = E_Detail.ユーザー名 WHERE (((Left([出港日],7))=‘" & [Forms]![出口売上詳細]![出港月份] & "‘)) ORDER BY I_Customer.顺序, E_Detail.契約*;" Set temRan = ExportToExcel(strSql, , 3, 1, "月客別詳細", "月客別詳細" & Format(Date, "yyyymmdd")) Call FExcel.setFormatTongJiKeHuXiangXi(temRan) Set temRn = temRan.Range(temRan.Cells(3, 1), temRan.Cells(temRan.UsedRange.Rows.Count, temRan.UsedRange.Columns.Count)) strSql = "SELECT Sum(E_Detail.金額) AS 金額之总计, E_Detail.通貨 FROM E_Detail WHERE Left([出港日],7)=‘" & [Forms]![出口売上詳細]![出港月份] & "‘ GROUP BY E_Detail.通貨;" Set temRan2 = ExportToExcel(strSql, , 1, 1) temRan2.UsedRange.Copy temRan.Cells(temRan.UsedRange.Rows.Count + 2, 11) temRan2.Parent.Close Call FExcel.setFormatBorders(temRn) excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True Exit Function Errprocessing: MsgBox Err.Description excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True End Function Function E_BOM_Query() Dim temWb As Workbook Dim temRan As Worksheet Dim temRan2 As Worksheet Dim temRn As Range On Error GoTo Errprocessing excel.Application.DisplayAlerts = False excel.Application.ScreenUpdating = False If IsNull([Forms]![需求计算]![合同号]) Then MsgBox "需要选择合同号；" Exit Function End If DoCmd.OutputTo acOutputQuery, "E_Bom查询", acFormatXLSX, CurrentProject.Path & "\" & "E_Bom查询" & Format(Date, "yyyymmdd") & ".xlsx", False Set temWb = Workbooks.Open(CurrentProject.Path & "\" & "E_Bom查询" & Format(Date, "yyyymmdd") & ".xlsx") temWb.Application.Visible = True Set temRan = temWb.Worksheets(1) Call FExcel.setFormatE_BOM_Query(temRan) Set temRn = temRan.Range(temRan.Cells(1, 1), temRan.Cells(temRan.UsedRange.Rows.Count, temRan.UsedRange.Columns.Count)) Call FExcel.setFormatBorders(temRn) excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True Exit Function Errprocessing: MsgBox Err.Description excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True End Function Function E_BOM_QueryAll() Dim temWb As Workbook Dim temRan As Worksheet Dim temRan2 As Worksheet Dim temRn As Range On Error GoTo Errprocessing excel.Application.DisplayAlerts = False excel.Application.ScreenUpdating = False DoCmd.OutputTo acOutputQuery, "E_Bom查询_All", acFormatXLSX, CurrentProject.Path & "\" & "E_Bom查询_All" & Format(Date, "yyyymmdd") & ".xlsx", False Set temWb = Workbooks.Open(CurrentProject.Path & "\" & "E_Bom查询_All" & Format(Date, "yyyymmdd") & ".xlsx") temWb.Application.Visible = True Set temRan = temWb.Worksheets(1) Call FExcel.setFormatE_BOM_QueryAll(temRan) Set temRn = temRan.Range(temRan.Cells(1, 1), temRan.Cells(temRan.UsedRange.Rows.Count, temRan.UsedRange.Columns.Count)) Call FExcel.setFormatBorders(temRn) excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True Exit Function Errprocessing: MsgBox Err.Description excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True End Function Function I_BOM_Query() Dim temWb As Workbook Dim temRan As Worksheet Dim temRan2 As Worksheet Dim temRn As Range On Error GoTo Errprocessing excel.Application.DisplayAlerts = False excel.Application.ScreenUpdating = False If IsNull([Forms]![需求计算]![国内合同号]) Then MsgBox "需要选择国内合同号；" Exit Function End If DoCmd.OutputTo acOutputQuery, "I_Bom查询", acFormatXLSX, CurrentProject.Path & "\" & "I_Bom查询" & Format(Date, "yyyymmdd") & ".xlsx", False Set temWb = Workbooks.Open(CurrentProject.Path & "\" & "I_Bom查询" & Format(Date, "yyyymmdd") & ".xlsx") temWb.Application.Visible = True Set temRan = temWb.Worksheets(1) Call FExcel.setFormatI_BOM_Query(temRan) Set temRn = temRan.Range(temRan.Cells(1, 1), temRan.Cells(temRan.UsedRange.Rows.Count, temRan.UsedRange.Columns.Count)) Call FExcel.setFormatBorders(temRn) excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True Exit Function Errprocessing: MsgBox Err.Description excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True End Function Function I_BOM_QueryAll() Dim temWb As Workbook Dim temRan As Worksheet Dim temRan2 As Worksheet Dim temRn As Range On Error GoTo Errprocessing excel.Application.DisplayAlerts = False excel.Application.ScreenUpdating = False DoCmd.OutputTo acOutputQuery, "I_Bom查询_All", acFormatXLSX, CurrentProject.Path & "\" & "I_Bom查询_All" & Format(Date, "yyyymmdd") & ".xlsx", False Set temWb = Workbooks.Open(CurrentProject.Path & "\" & "I_Bom查询_All" & Format(Date, "yyyymmdd") & ".xlsx") temWb.Application.Visible = True Set temRan = temWb.Worksheets(1) Call FExcel.setFormatI_BOM_QueryAll(temRan) Set temRn = temRan.Range(temRan.Cells(1, 1), temRan.Cells(temRan.UsedRange.Rows.Count, temRan.UsedRange.Columns.Count)) Call FExcel.setFormatBorders(temRn) excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True Exit Function Errprocessing: MsgBox Err.Description excel.Application.DisplayAlerts = True excel.Application.ScreenUpdating = True End Function Function setTextBoxValue(valePri, Formname, ControlName) Forms(Formname).Controls(ControlName) = valePri End Function Sub abc() Call guoneiChuKuPiao End Sub
Option Compare Database Sub setFormatI_BOM_QueryAll(temWh As Worksheet) With temWh .Cells.WrapText = False ‘ .Columns.AutoFit maxRow = .UsedRange.Rows.Count startMerge = 2 For i = 2 To maxRow If .Cells(i, 18) = 1 Then If i - 1 > startMerge Then .Range(.Cells(startMerge, 2), .Cells(i - 1, 2)).Merge .Range(.Cells(startMerge, 3), .Cells(i - 1, 3)).Merge End If .Range(.Cells(i, 1), .Cells(i, 18)).Interior.Color = 65535 startMerge = i + 1 Else If .Cells(i, 2) = .Cells(i - 1, 2) And .Cells(i, 3) = .Cells(i - 1, 3) Then If i = maxRow Then .Range(.Cells(startMerge, 2), .Cells(i, 2)).Merge .Range(.Cells(startMerge, 3), .Cells(i, 3)).Merge End If Else If i - 1 > startMerge Then .Range(.Cells(startMerge, 2), .Cells(i - 1, 2)).Merge .Range(.Cells(startMerge, 3), .Cells(i - 1, 3)).Merge startMerge = i Else startMerge = i End If End If End If Next End With End Sub Sub setFormatI_BOM_Query(temWh As Worksheet) With temWh .Cells.WrapText = False .Columns.AutoFit maxRow = .UsedRange.Rows.Count startMerge = 2 For i = 2 To maxRow If .Cells(i, 15) = 1 Then If i - 1 > startMerge Then .Range(.Cells(startMerge, 2), .Cells(i - 1, 2)).Merge .Range(.Cells(startMerge, 14), .Cells(i - 1, 14)).Merge End If .Range(.Cells(i, 1), .Cells(i, 15)).Interior.Color = 65535 startMerge = i + 1 Else If .Cells(i, 2) = .Cells(i - 1, 2) And .Cells(i, 14) = .Cells(i - 1, 14) Then If i = maxRow Then .Range(.Cells(startMerge, 2), .Cells(i, 2)).Merge .Range(.Cells(startMerge, 14), .Cells(i, 14)).Merge End If Else If i - 1 > startMerge Then .Range(.Cells(startMerge, 2), .Cells(i - 1, 2)).Merge .Range(.Cells(startMerge, 14), .Cells(i - 1, 14)).Merge startMerge = i Else startMerge = i End If End If End If Next End With End Sub Sub setFormatE_BOM_QueryAll(temWh As Worksheet) With temWh .Cells.WrapText = False ‘ .Columns.AutoFit maxRow = .UsedRange.Rows.Count startMerge = 2 For i = 2 To maxRow If .Cells(i, 24) = 1 Then If i - 1 > startMerge Then .Range(.Cells(startMerge, 2), .Cells(i - 1, 2)).Merge .Range(.Cells(startMerge, 16), .Cells(i - 1, 16)).Merge End If .Range(.Cells(i, 1), .Cells(i, 24)).Interior.Color = 65535 startMerge = i + 1 Else If .Cells(i, 2) = .Cells(i - 1, 2) And .Cells(i, 16) = .Cells(i - 1, 16) Then If i = maxRow Then .Range(.Cells(startMerge, 2), .Cells(i, 2)).Merge .Range(.Cells(startMerge, 16), .Cells(i, 16)).Merge End If Else If i - 1 > startMerge Then .Range(.Cells(startMerge, 2), .Cells(i - 1, 2)).Merge .Range(.Cells(startMerge, 16), .Cells(i - 1, 16)).Merge startMerge = i Else startMerge = i End If End If End If Next End With End Sub Sub setFormatE_BOM_Query(temWh As Worksheet) With temWh .Cells.WrapText = False .Columns.AutoFit maxRow = .UsedRange.Rows.Count startMerge = 2 For i = 2 To maxRow If .Cells(i, 16) = 1 Then If i - 1 > startMerge Then .Range(.Cells(startMerge, 2), .Cells(i - 1, 2)).Merge .Range(.Cells(startMerge, 3), .Cells(i - 1, 3)).Merge End If .Range(.Cells(i, 1), .Cells(i, 16)).Interior.Color = 65535 startMerge = i + 1 Else If .Cells(i, 1) = .Cells(i - 1, 1) And .Cells(i, 3) = .Cells(i - 1, 3) Then If i = maxRow Then .Range(.Cells(startMerge, 2), .Cells(i, 2)).Merge .Range(.Cells(startMerge, 3), .Cells(i, 3)).Merge End If Else If i - 1 > startMerge Then .Range(.Cells(startMerge, 2), .Cells(i - 1, 2)).Merge .Range(.Cells(startMerge, 3), .Cells(i - 1, 3)).Merge startMerge = i Else startMerge = i End If End If End If Next End With End Sub Sub setFormatTongJiKeHuXiangXi(temWh As Worksheet) With temWh .Columns.AutoFit maxRow = .UsedRange.Rows.Count .Range(.Cells(3, 1), .Cells(maxRow, 13)).NumberFormatLocal = "G/通用格式" .Cells(1, 1) = Val(Right([Forms]![出口売上詳細]![出港月份], 2)) & "月輸出売上客別詳細" For i = maxRow - 1 To 3 Step -1 If .Cells(i, 1) <> .Cells(i + 1, 1) Then .Rows(i + 1).Insert .Rows(i + 1).Interior.Pattern = xlNone End If Next maxRow = .UsedRange.Rows.Count startMerge = 3 For i = 3 To maxRow If .Cells(i, 13) <> "" Then .Range(.Cells(i, 1), .Cells(i, 13)).Interior.Color = .Cells(i, 13) If .Cells(i, 12) = "$" Then .Cells(i, 7).NumberFormatLocal = "$#,##0.00_);[红色]($#,##0.00)" .Cells(i, 8).NumberFormatLocal = "$#,##0.00_);[红色]($#,##0.00)" .Cells(i, 11).NumberFormatLocal = "$#,##0.00_);[红色]($#,##0.00)" ElseIf .Cells(i, 12) = "円" Then .Cells(i, 7).NumberFormatLocal = "￥#,##0.00;￥-#,##0.00" .Cells(i, 8).NumberFormatLocal = "￥#,##0.00;￥-#,##0.00" .Cells(i, 11).NumberFormatLocal = "￥#,##0.00;￥-#,##0.00" End If If .Cells(i, 2) = .Cells(i - 1, 2) Then If i = maxRow Then .Range(.Cells(startMerge, 2), .Cells(i, 2)).Merge .Range(.Cells(startMerge, 1), .Cells(i, 1)).Merge .Range(.Cells(startMerge, 3), .Cells(i, 3)).Merge .Range(.Cells(startMerge, 9), .Cells(i, 9)).Merge .Range(.Cells(startMerge, 12), .Cells(i, 12)).Merge .Range(.Cells(startMerge, 11), .Cells(i, 11)).Merge End If Else If i - 1 > startMerge Then .Range(.Cells(startMerge, 2), .Cells(i - 1, 2)).Merge .Range(.Cells(startMerge, 1), .Cells(i - 1, 1)).Merge .Range(.Cells(startMerge, 3), .Cells(i - 1, 3)).Merge .Range(.Cells(startMerge, 9), .Cells(i - 1, 9)).Merge .Range(.Cells(startMerge, 12), .Cells(i - 1, 12)).Merge .Range(.Cells(startMerge, 11), .Cells(i - 1, 11)).Merge startMerge = i Else startMerge = i End If End If Next .Range(.Cells(3, 13), .Cells(maxRow, 13)).ClearContents Union(.Columns(1), .Columns(5), .Columns(12)).HorizontalAlignment = xlCenter End With End Sub Sub setFormatTongJiZhiPin(temWh As Worksheet) With temWh .Columns.AutoFit maxRow = .UsedRange.Rows.Count For i = 2 To maxRow If .Cells(i, 5) = "$" Then .Cells(i, 8).NumberFormatLocal = "$#,##0.00_);[红色]($#,##0.00)" ElseIf .Cells(i, 5) = "円" Then .Cells(i, 8).NumberFormatLocal = "￥#,##0.00;￥-#,##0.00" End If Next End With End Sub Sub setFormatJinEXiangXi(temWh As Worksheet) With temWh maxRow = .UsedRange.Rows.Count .Range(.Cells(2, 2), .Cells(maxRow, 15)).NumberFormatLocal = "G/通用格式" For i = maxRow - 1 To 2 Step -1 If .Cells(i, 2) <> .Cells(i + 1, 2) Then .Rows(i + 1).Insert .Rows(i + 1).Interior.Pattern = xlNone End If Next maxRow = .UsedRange.Rows.Count startMerge = 2 For i = 2 To maxRow If .Cells(i, 15) <> "" Then .Range(.Cells(i, 2), .Cells(i, 15)).Interior.Color = .Cells(i, 15) If .Cells(i, 10) = "$" Then .Cells(i, 7).NumberFormatLocal = "$#,##0.00_);[红色]($#,##0.00)" .Cells(i, 9).NumberFormatLocal = "$#,##0.00_);[红色]($#,##0.00)" .Cells(i, 14).NumberFormatLocal = "$#,##0.00_);[红色]($#,##0.00)" ElseIf .Cells(i, 10) = "円" Then .Cells(i, 7).NumberFormatLocal = "￥#,##0.00;￥-#,##0.00" .Cells(i, 9).NumberFormatLocal = "￥#,##0.00;￥-#,##0.00" .Cells(i, 14).NumberFormatLocal = "￥#,##0.00;￥-#,##0.00" End If If .Cells(i, 13) = .Cells(i - 1, 13) Then If i = maxRow Then .Range(.Cells(startMerge, 2), .Cells(i, 2)).Merge .Range(.Cells(startMerge, 13), .Cells(i, 13)).Merge .Range(.Cells(startMerge, 14), .Cells(i, 14)).Merge .Range(.Cells(startMerge, 12), .Cells(i, 12)).Merge .Range(.Cells(startMerge, 11), .Cells(i, 11)).Merge End If Else If i - 1 > startMerge Then .Range(.Cells(startMerge, 2), .Cells(i - 1, 2)).Merge .Range(.Cells(startMerge, 13), .Cells(i - 1, 13)).Merge .Range(.Cells(startMerge, 14), .Cells(i - 1, 14)).Merge .Range(.Cells(startMerge, 12), .Cells(i - 1, 12)).Merge .Range(.Cells(startMerge, 11), .Cells(i - 1, 11)).Merge startMerge = i Else startMerge = i End If End If Next .Range(.Cells(2, 15), .Cells(maxRow, 15)).ClearContents Union(.Columns(2), .Columns(5), .Columns(10)).HorizontalAlignment = xlCenter End With End Sub Sub setFormatTongJiKeHu(temWh As Worksheet) With temWh maxRow = .UsedRange.Rows.Count For i = maxRow - 1 To 2 Step -1 If .Cells(i, 2) <> .Cells(i + 1, 2) Then .Rows(i + 1).Insert .Rows(i + 1).Interior.Pattern = xlNone End If Next maxRow = .UsedRange.Rows.Count startMerge = 2 For i = 2 To maxRow If .Cells(i, 16) <> "" Then .Range(.Cells(i, 2), .Cells(i, 15)).Interior.Color = .Cells(i, 16) If .Cells(i, 10) = "$" Then .Cells(i, 8).NumberFormatLocal = "$#,##0.00_);[红色]($#,##0.00)" .Cells(i, 9).NumberFormatLocal = "$#,##0.00_);[红色]($#,##0.00)" .Cells(i, 15).NumberFormatLocal = "$#,##0.00_);[红色]($#,##0.00)" ElseIf .Cells(i, 10) = "円" Then .Cells(i, 8).NumberFormatLocal = "￥#,##0.00;￥-#,##0.00" .Cells(i, 9).NumberFormatLocal = "￥#,##0.00;￥-#,##0.00" .Cells(i, 15).NumberFormatLocal = "￥#,##0.00;￥-#,##0.00" End If If .Cells(i, 3) = .Cells(i - 1, 3) Then If i = maxRow Then .Range(.Cells(startMerge, 2), .Cells(i, 2)).Merge .Range(.Cells(startMerge, 3), .Cells(i, 3)).Merge .Range(.Cells(startMerge, 4), .Cells(i, 4)).Merge .Range(.Cells(startMerge, 12), .Cells(i, 12)).Merge .Range(.Cells(startMerge, 11), .Cells(i, 11)).Merge .Range(.Cells(startMerge, 15), .Cells(i, 15)).Merge End If Else If i - 1 > startMerge Then .Range(.Cells(startMerge, 2), .Cells(i - 1, 2)).Merge .Range(.Cells(startMerge, 3), .Cells(i - 1, 3)).Merge .Range(.Cells(startMerge, 4), .Cells(i - 1, 4)).Merge .Range(.Cells(startMerge, 12), .Cells(i - 1, 12)).Merge .Range(.Cells(startMerge, 11), .Cells(i - 1, 11)).Merge .Range(.Cells(startMerge, 15), .Cells(i - 1, 15)).Merge startMerge = i Else startMerge = i End If End If Next .Range(.Cells(2, 16), .Cells(maxRow, 16)).ClearContents .Range(.Cells(2, 2), .Cells(maxRow, 7)).NumberFormatLocal = "G/通用格式" .Range(.Cells(2, 11), .Cells(maxRow, 14)).NumberFormatLocal = "G/通用格式" Union(.Columns(2), .Columns(3), .Columns(10)).HorizontalAlignment = xlCenter End With End Sub Sub setFormatWeishengchan(temWh As Worksheet) With temWh maxRow = .UsedRange.Rows.Count .UsedRange.Select startMerge = 2 For i = 2 To maxRow .Range(.Cells(i, 1), .Cells(i, 2)).Merge If .Cells(i, 7) = .Cells(i - 1, 7) And .Cells(i, 10) = .Cells(i - 1, 10) Then If i = maxRow Then .Range(.Cells(startMerge, 10), .Cells(i, 10)).Merge End If Else If i - 1 > startMerge Then .Range(.Cells(startMerge, 10), .Cells(i - 1, 10)).Merge startMerge = i Else startMerge = i End If End If Next startMerge = 2 For i = 2 To maxRow If .Cells(i, 1) = .Cells(i - 1, 1) And .Cells(i, 7) = .Cells(i - 1, 7) And .Cells(i, 8) = .Cells(i - 1, 8) Then If i = maxRow Then .Range(.Cells(startMerge, 8), .Cells(i, 8)).Merge End If Else If i - 1 > startMerge Then .Range(.Cells(startMerge, 8), .Cells(i - 1, 8)).Merge startMerge = i Else startMerge = i End If End If Next startMerge = 2 For i = 2 To maxRow If .Cells(i, 1) = .Cells(i - 1, 1) And .Cells(i, 7) = .Cells(i - 1, 7) Then If i = maxRow Then .Range(.Cells(startMerge, 7), .Cells(i, 7)).Merge End If Else If i - 1 > startMerge Then .Range(.Cells(startMerge, 7), .Cells(i - 1, 7)).Merge startMerge = i Else startMerge = i End If End If Next startMerge = 2 For i = 2 To maxRow If .Cells(i, 1) = .Cells(i - 1, 1) Then If i = maxRow Then .Range(.Cells(startMerge, 1), .Cells(i, 2)).Merge End If Else If i - 1 > startMerge Then .Range(.Cells(startMerge, 1), .Cells(i - 1, 2)).Merge startMerge = i Else startMerge = i End If End If Next End With End Sub Sub setFormatTongJiJinE(temWh As Worksheet) With temWh maxRow = .UsedRange.Rows.Count startMerge = maxRow For i = maxRow - 1 To 2 Step -1 If .Cells(i, 2) <> .Cells(i + 1, 2) Then .Rows(i + 1).Insert .Rows(i + 1).Interior.Pattern = xlNone End If Next maxRow = .UsedRange.Rows.Count startMerge = 2 For i = 2 To maxRow If .Cells(i, 3) = .Cells(i - 1, 3) And .Cells(i, 13) = .Cells(i - 1, 13) Then If i = maxRow Then .Range(.Cells(startMerge, 13), .Cells(i, 13)).Merge End If Else If i - 1 > startMerge Then .Range(.Cells(startMerge, 13), .Cells(i - 1, 13)).Merge startMerge = i Else startMerge = i End If End If Next startMerge = 2 For i = 2 To maxRow If .Cells(i, 3) = .Cells(i - 1, 3) Then If i = maxRow Then .Range(.Cells(startMerge, 2), .Cells(i, 2)).Merge .Range(.Cells(startMerge, 3), .Cells(i, 3)).Merge .Range(.Cells(startMerge, 4), .Cells(i, 4)).Merge .Range(.Cells(startMerge, 14), .Cells(i, 14)).Merge End If Else If i - 1 > startMerge Then .Range(.Cells(startMerge, 2), .Cells(i - 1, 2)).Merge .Range(.Cells(startMerge, 3), .Cells(i - 1, 3)).Merge .Range(.Cells(startMerge, 4), .Cells(i - 1, 4)).Merge .Range(.Cells(startMerge, 14), .Cells(i - 1, 14)).Merge startMerge = i Else startMerge = i End If End If Next End With End Sub Sub setFormatGuoNeiYingShou(temWh As Worksheet) With temWh maxRow = .UsedRange.Rows.Count If maxRow < 4 Then Exit Sub .Cells(1, 1) = CLng(Left(.Cells(4, 11), 4)) & "年 " & CLng(Right(.Cells(4, 11), 2)) & "月内销明细" .Range(.Cells(4, 11), .Cells(maxRow, 11)).ClearContents startMerge = 4 For i = 4 To maxRow If .Cells(i, 1) = .Cells(i - 1, 1) Then If i = maxRow Then .Range(.Cells(startMerge, 1), .Cells(i, 1)).Merge .Range(.Cells(startMerge, 2), .Cells(i, 2)).Merge .Range(.Cells(startMerge, 3), .Cells(i, 3)).Merge .Range(.Cells(startMerge, 10), .Cells(i, 10)).Merge .Range(.Cells(startMerge, 11), .Cells(i, 11)).Merge End If Else If i - 1 > startMerge Then .Range(.Cells(startMerge, 1), .Cells(i - 1, 1)).Merge .Range(.Cells(startMerge, 2), .Cells(i - 1, 2)).Merge .Range(.Cells(startMerge, 3), .Cells(i - 1, 3)).Merge .Range(.Cells(startMerge, 10), .Cells(i - 1, 10)).Merge .Range(.Cells(startMerge, 11), .Cells(i - 1, 11)).Merge startMerge = i Else startMerge = i End If End If Next .Cells(maxRow + 1, 1) = "总计：" .Cells(maxRow + 1, 2).FormulaR1C1 = "=sum(r4c:r[-1]c)" .Cells(maxRow + 1, 3).FormulaR1C1 = "=sum(r4c:r[-1]c)" .Cells(maxRow + 1, 10).FormulaR1C1 = "=sum(r4c:r[-1]c)" .Cells(maxRow + 1, 11).FormulaR1C1 = "=sum(r4c:r[-1]c)" .Rows(maxRow + 1).Font.Size = 16 .Columns(2).NumberFormatLocal = "￥#,##0.00;￥-#,##0.00" .Columns(3).NumberFormatLocal = "￥#,##0.00;￥-#,##0.00" .Columns(8).NumberFormatLocal = "￥#,##0.00;￥-#,##0.00" .Columns(9).NumberFormatLocal = "￥#,##0.00;￥-#,##0.00" .Columns(10).NumberFormatLocal = "￥#,##0.00;￥-#,##0.00" .Columns(11).NumberFormatLocal = "￥#,##0.00;￥-#,##0.00" .Cells.Font.Bold = True End With End Sub Sub setFormatGuoNeiYueXiaoShouHuizong(temWh As Worksheet) With temWh maxRow = .UsedRange.Rows.Count If maxRow < 3 Then Exit Sub .Cells(1, 1) = CLng(Left(.Cells(3, 9), 4)) & "年 " & CLng(Right(.Cells(3, 9), 2)) & "月内销明细" .Range(.Cells(3, 9), .Cells(maxRow, 9)).ClearContents For i = 3 To maxRow .Cells(i, 1) = i - 2 Next .Cells(maxRow + 1, 2) = "金额合计" .Cells(maxRow + 1, 8).FormulaR1C1 = "=sum(r3c:r[-1]c)" .Cells.Font.Name = "Arial" .Rows(maxRow + 1).Font.Bold = True End With End Sub Sub setFormatGuoNeiYueXiaoShouMingxi(temWh As Worksheet) With temWh maxRow = .UsedRange.Rows.Count If maxRow < 3 Then Exit Sub .Cells(1, 1) = CLng(Left(.Cells(3, 9), 4)) & "年 " & CLng(Right(.Cells(3, 9), 2)) & "月内销明细" .Range(.Cells(3, 9), .Cells(maxRow, 9)).ClearContents For i = maxRow To 3 Step -1 If .Cells(i, 1) <> .Cells(i + 1, 1) Then .Rows(i + 1).Insert .Rows(i + 1).Interior.Pattern = xlNone .Cells(i + 1, 1) = "金额合计" End If Next maxRow = .UsedRange.Rows.Count startMerge = 3 For i = 3 To maxRow If .Cells(i, 1) = "金额合计" Then .Cells(i, 8).FormulaR1C1 = "=sum(r" & startMerge & "c:r[-1]c)" startMerge = i + 1 Rows(i).Font.Color = -65536 Rows(i).Font.Bold = True End If Next End With End Sub Sub setFormatChuKuPiao(temWh As Worksheet) PaperCount = 1 With temWh maxRow = .UsedRange.Rows.Count .Range(.Cells(4, 1), .Cells(11, 8)).ClearContents If maxRow < 15 Then Exit Sub PaperCount = excel.Application.WorksheetFunction.RoundUp((maxRow - 14) / 8, 0) For i = 1 To PaperCount - 1 Rows("1:13").Copy Rows(13 * i + 1).Insert Shift:=xlDown Next maxRow = .UsedRange.Rows.Count For i = 0 To PaperCount - 1 .Range(.Cells(15 + (PaperCount - 1) * 13 + i * 8, 2), .Cells(22 + (PaperCount - 1) * 13 + i * 8, 8)).Copy .Cells(4 + i * 13, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False .Cells(13 + i * 13, 8) = " " & i + 1 & "/" & PaperCount For j = 4 To 11 If .Cells(j + i * 13, 2) <> "" Then .Cells(j + i * 13, 1) = j - 3 End If Next Next .Rows(15 + (PaperCount - 1) * 13 & ":" & maxRow).Delete End With End Sub Sub setFormatSuiHuoDan(temWh As Worksheet) PaperCount = 1 With temWh maxRow = .UsedRange.Rows.Count .Range(.Cells(4, 1), .Cells(13, 13)).ClearContents If maxRow < 21 Then Exit Sub PaperCount = excel.Application.WorksheetFunction.RoundUp((maxRow - 20) / 10, 0) For i = 1 To PaperCount - 1 Rows("1:19").Copy Rows(19 * i + 1).Insert Shift:=xlDown Next maxRow = .UsedRange.Rows.Count For i = 0 To PaperCount - 1 .Range(.Cells(21 + (PaperCount - 1) * 19 + i * 10, 2), .Cells(30 + (PaperCount - 1) * 19 + i * 10, 13)).Copy .Cells(4 + i * 19, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ‘ .Cells(13 + i * 13, 8) = " " & i + 1 & "/" & PaperCount For j = 4 To 13 If .Cells(j + i * 19, 4) <> "" Then .Cells(j + i * 19, 1) = j - 3 End If Next Next .Rows(21 + (PaperCount - 1) * 19 & ":" & maxRow).Delete End With End Sub Sub setFormatSuiHuoDanLijia(temWh As Worksheet) PaperCount = 1 With temWh maxRow = .UsedRange.Rows.Count .Range(.Cells(5, 1), .Cells(10, 12)).ClearContents If maxRow < 18 Then Exit Sub PaperCount = excel.Application.WorksheetFunction.RoundUp((maxRow - 17) / 6, 0) For i = 1 To PaperCount - 1 Rows("1:16").Copy Rows(16 * i + 1).Insert Shift:=xlDown Next maxRow = .UsedRange.Rows.Count For i = 0 To PaperCount - 1 .Range(.Cells(18 + (PaperCount - 1) * 16 + i * 6, 2), .Cells(23 + (PaperCount - 1) * 16 + i * 6, 12)).Copy .Cells(5 + i * 16, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ‘ .Cells(13 + i * 13, 8) = " " & i + 1 & "/" & PaperCount For j = 5 To 10 If .Cells(j + i * 16, 2) <> "" Then .Cells(j + i * 16, 1) = j - 4 End If Next Next .Rows(18 + (PaperCount - 1) * 16 & ":" & maxRow).Delete End With End Sub Sub setFormatWeiChuHeChuGang(temWh As Worksheet) With temWh maxRow = .UsedRange.Rows.Count startMerge = 3 For i = 3 To maxRow If .Cells(i, 19) = .Cells(i - 1, 19) Then If i = maxRow Then .Range(.Cells(startMerge, 19), .Cells(i, 19)).Merge End If Else If i - 1 > startMerge Then .Range(.Cells(startMerge, 19), .Cells(i - 1, 19)).Merge startMerge = i Else startMerge = i End If End If .Range(.Cells(i, 1), .Cells(i, 14)).Interior.Color = .Cells(i, 20) Next .Range(.Cells(3, 20), .Cells(maxRow, 20)).Delete startMerge = 3 For i = 3 To maxRow If .Cells(i, 10) = .Cells(i - 1, 10) Then If i = maxRow Then .Range(.Cells(startMerge, 1), .Cells(i, 1)).Merge .Range(.Cells(startMerge, 2), .Cells(i, 2)).Merge .Range(.Cells(startMerge, 6), .Cells(i, 6)).Merge .Range(.Cells(startMerge, 7), .Cells(i, 7)).Merge .Range(.Cells(startMerge, 8), .Cells(i, 8)).Merge .Range(.Cells(startMerge, 9), .Cells(i, 9)).Merge .Range(.Cells(startMerge, 10), .Cells(i, 10)).Merge .Range(.Cells(startMerge, 13), .Cells(i, 13)).Merge .Range(.Cells(startMerge, 14), .Cells(i, 14)).Merge End If Else If i - 1 > startMerge Then .Range(.Cells(startMerge, 1), .Cells(i - 1, 1)).Merge .Range(.Cells(startMerge, 2), .Cells(i - 1, 2)).Merge .Range(.Cells(startMerge, 6), .Cells(i - 1, 6)).Merge .Range(.Cells(startMerge, 7), .Cells(i - 1, 7)).Merge .Range(.Cells(startMerge, 8), .Cells(i - 1, 8)).Merge .Range(.Cells(startMerge, 9), .Cells(i - 1, 9)).Merge .Range(.Cells(startMerge, 10), .Cells(i - 1, 10)).Merge .Range(.Cells(startMerge, 13), .Cells(i - 1, 13)).Merge .Range(.Cells(startMerge, 14), .Cells(i - 1, 14)).Merge startMerge = i Else startMerge = i End If End If Next With .Range(.Cells(3, 1), .Cells(maxRow, 19)) .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext End With .Columns("C:D").HorizontalAlignment = xlLeft .Columns("N:N").HorizontalAlignment = xlLeft .Columns("S:S").HorizontalAlignment = xlLeft .Columns(15).HorizontalAlignment = xlLeft End With End Sub Sub setFormatWeiChuHeKeHu(temWh As Worksheet) With temWh maxRow = .UsedRange.Rows.Count startMerge = maxRow For i = maxRow - 1 To 3 Step -1 If .Cells(i, 2) <> .Cells(i + 1, 2) Then .Rows(i + 1).Insert .Rows(i + 1).Interior.Pattern = xlNone End If Next maxRow = .UsedRange.Rows.Count startMerge = 3 For i = 3 To maxRow If .Cells(i, 19) = .Cells(i - 1, 19) Then If i = maxRow Then .Range(.Cells(startMerge, 19), .Cells(i, 19)).Merge End If Else If i - 1 > startMerge Then .Range(.Cells(startMerge, 19), .Cells(i - 1, 19)).Merge startMerge = i Else startMerge = i End If End If If .Cells(i, 2) <> "" Then .Range(.Cells(i, 1), .Cells(i, 14)).Interior.Color = .Cells(i, 20) Next .Range(.Cells(3, 20), .Cells(maxRow, 20)).Delete startMerge = 3 For i = 3 To maxRow If .Cells(i, 10) = .Cells(i - 1, 10) Then If i = maxRow Then .Range(.Cells(startMerge, 1), .Cells(i, 1)).Merge .Range(.Cells(startMerge, 2), .Cells(i, 2)).Merge .Range(.Cells(startMerge, 6), .Cells(i, 6)).Merge .Range(.Cells(startMerge, 7), .Cells(i, 7)).Merge .Range(.Cells(startMerge, 8), .Cells(i, 8)).Merge .Range(.Cells(startMerge, 9), .Cells(i, 9)).Merge .Range(.Cells(startMerge, 10), .Cells(i, 10)).Merge .Range(.Cells(startMerge, 13), .Cells(i, 13)).Merge .Range(.Cells(startMerge, 14), .Cells(i, 14)).Merge End If Else If i - 1 > startMerge Then .Range(.Cells(startMerge, 1), .Cells(i - 1, 1)).Merge .Range(.Cells(startMerge, 2), .Cells(i - 1, 2)).Merge .Range(.Cells(startMerge, 6), .Cells(i - 1, 6)).Merge .Range(.Cells(startMerge, 7), .Cells(i - 1, 7)).Merge .Range(.Cells(startMerge, 8), .Cells(i - 1, 8)).Merge .Range(.Cells(startMerge, 9), .Cells(i - 1, 9)).Merge .Range(.Cells(startMerge, 10), .Cells(i - 1, 10)).Merge .Range(.Cells(startMerge, 13), .Cells(i - 1, 13)).Merge .Range(.Cells(startMerge, 14), .Cells(i - 1, 14)).Merge startMerge = i Else startMerge = i End If End If Next With .Range(.Cells(3, 1), .Cells(maxRow, 19)) .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext End With .Columns("C:D").HorizontalAlignment = xlLeft .Columns("N:N").HorizontalAlignment = xlLeft .Columns("S:S").HorizontalAlignment = xlLeft .Columns(15).HorizontalAlignment = xlLeft End With End Sub Sub setFormatWeiChuHeJingLi(temWh As Worksheet) With temWh maxRow = .UsedRange.Rows.Count .Range(.Cells(6, 1), .Cells(maxRow, 21)).NumberFormatLocal = "G/通用格式" startMerge = maxRow For i = maxRow - 1 To 5 Step -1 If .Cells(i, 22) <> .Cells(i + 1, 22) Then .Rows(i + 1).Insert .Rows(i + 1).Interior.Pattern = xlNone .Cells(i + 1, 1) = .Cells(i + 2, 22) .Range(.Cells(i + 1, 1), .Cells(i + 1, 14)).Merge .Range(.Cells(i + 1, 1), .Cells(i + 1, 14)).Interior.Color = 16751103 .Range(.Cells(i + 1, 1), .Cells(i + 1, 14)).Font.Bold = True .Range(.Cells(i + 1, 1), .Cells(i + 1, 14)).HorizontalAlignment = xlCenter End If Next maxRow = .UsedRange.Rows.Count startMerge = 6 For i = 6 To maxRow If .Cells(i, 17) = "$" Then .Cells(i, 12).NumberFormatLocal = "$#,##0.00_);[红色]($#,##0.00)" .Cells(i, 15).NumberFormatLocal = "$#,##0.00_);[红色]($#,##0.00)" .Cells(i, 16).NumberFormatLocal = "$#,##0.00_);[红色]($#,##0.00)" .Cells(i, 18).NumberFormatLocal = "$#,##0.00_);[红色]($#,##0.00)" ElseIf .Cells(i, 17) = "円" Then .Cells(i, 12).NumberFormatLocal = "￥#,##0.00;￥-#,##0.00" .Cells(i, 15).NumberFormatLocal = "￥#,##0.00;￥-#,##0.00" .Cells(i, 16).NumberFormatLocal = "￥#,##0.00;￥-#,##0.00" .Cells(i, 18).NumberFormatLocal = "￥#,##0.00;￥-#,##0.00" End If If .Cells(i, 13) = .Cells(i - 1, 13) And .Cells(i, 13) <> "" Then If i = maxRow Then .Range(.Cells(startMerge, 13), .Cells(i, 13)).Merge End If Else If i - 1 > startMerge Then .Range(.Cells(startMerge, 13), .Cells(i - 1, 13)).Merge startMerge = i Else startMerge = i End If End If Next ‘ .Range(.Cells(3, 20), .Cells(maxRow, 20)).Delete startMerge = 6 For i = 6 To maxRow If .Cells(i, 11) = .Cells(i - 1, 11) Then If i = maxRow Then .Range(.Cells(startMerge, 6), .Cells(i, 6)).Merge .Range(.Cells(startMerge, 9), .Cells(i, 9)).Merge .Range(.Cells(startMerge, 10), .Cells(i, 10)).Merge .Range(.Cells(startMerge, 11), .Cells(i, 11)).Merge .Range(.Cells(startMerge, 18), .Cells(i, 18)).Merge End If Else If i - 1 > startMerge Then .Range(.Cells(startMerge, 6), .Cells(i - 1, 6)).Merge .Range(.Cells(startMerge, 9), .Cells(i - 1, 9)).Merge .Range(.Cells(startMerge, 10), .Cells(i - 1, 10)).Merge .Range(.Cells(startMerge, 11), .Cells(i - 1, 11)).Merge .Range(.Cells(startMerge, 18), .Cells(i - 1, 18)).Merge startMerge = i Else startMerge = i End If End If Next ‘ With .Range(.Cells(6, 1), .Cells(maxRow, 19)) ‘ .HorizontalAlignment = xlCenter ‘ .VerticalAlignment = xlCenter ‘ .WrapText = False ‘ .Orientation = 0 ‘ .AddIndent = False ‘ .IndentLevel = 0 ‘ .ShrinkToFit = False ‘ .ReadingOrder = xlContext ‘ End With ‘ .Columns("C:D").HorizontalAlignment = xlLeft ‘ .Columns("N:N").HorizontalAlignment = xlLeft ‘ .Columns("S:S").HorizontalAlignment = xlLeft ‘ .Columns(15).HorizontalAlignment = xlLeft End With End Sub Sub setFormatMingxi(temRn As Range) temRn.Parent.Select temRn.Select Selection.Font.Size = 11 End Sub Function ExportToExcel(strSql, Optional NewHeadTitle As Boolean = False, Optional startRow As Long = 2, Optional startColumn As Long = 1, Optional strTemplate, Optional FileName) As Worksheet Dim rst As New ADODB.Recordset Dim Excel1 As Workbook ‘ 定义引用 Microsoft Excel 的变量。 Dim i As Integer Dim WJ1, WJ2, s As String If Not IsMissing(strTemplate) Then If InStr(1, UCase(strTemplate), ".XLS") > 0 Or InStr(1, UCase(strTemplate), ".XLSX") > 0 Then ‘有扩展名 WJ1 = CurrentProject.Path & "\" & strTemplate ‘模板文件名 （CurrentProject.Path为当前数据库的路径） Else WJ1 = CurrentProject.Path & "\" & strTemplate & ".XLSX" ‘模板文件名 （CurrentProject.Path为当前数据库的路径） End If End If If Not IsMissing(FileName) Then If InStr(1, UCase(FileName), ".XLS") > 0 Or InStr(1, UCase(FileName), ".XLSX") > 0 Then ‘有扩展名 WJ2 = CurrentProject.Path & "\" & FileName ‘目标文件名 Else WJ2 = CurrentProject.Path & "\" & FileName & ".XLSX" ‘目标文件名 End If End If If Not IsMissing(strTemplate) And Not IsMissing(FileName) Then FileCopy WJ1, WJ2 Set Excel1 = excel.Workbooks.Open(WJ2) ‘建立与Excel的连接变量 ElseIf Not IsMissing(FileName) Then Set Excel1 = Workbooks.Add Excel1.SaveAs WJ2 Else Set Excel1 = Workbooks.Add End If Excel1.Application.Visible = True Set ExportToExcel = Excel1.Worksheets(1) rst.Open strSql, CurrentProject.Connection, 1, 1 If NewHeadTitle = True Then For i = 1 To rst.Fields.Count ‘按字段数循环 ExportToExcel.Cells(1, i).Value = rst(i - 1).Name ‘在Excel列中填写数据 Next i End If temMaxRow = ExportToExcel.UsedRange.Rows.Count If temMaxRow >= startRow Then ExportToExcel.Rows(startRow & ":" & temMaxRow).Delete End If ‘ On Error GoTo 0 ExportToExcel.Cells(startRow, startColumn).CopyFromRecordset rst End Function Function dateFormat(temStr) If IsDate(temStr) Then dateFormat = Format(temStr, "yyyy.mm.dd") Else dateFormat = temStr End If End Function Sub setFormatBorders(temRn As Range, Optional LStyle = 1, Optional TStyle = 1, Optional BStyle = 1, Optional RStyle = 1, Optional VStyle = 1, Optional HStyle = 1, Optional LColor = 0, Optional TColor = 0, Optional BColor = 0, Optional RColor = 0, Optional VColor = 0, Optional HColor = 0, Optional LWeight = 2, Optional TWeight = 2, Optional BWeight = 2, Optional RWeight = 2, Optional VWeight = 2, Optional HWeight = 2) temRn.Borders(xlDiagonalDown).LineStyle = xlNone temRn.Borders(xlDiagonalUp).LineStyle = xlNone With temRn.Borders(xlEdgeLeft) .LineStyle = LStyle .Color = LColor .TintAndShade = 0 .Weight = LWeight End With With temRn.Borders(xlEdgeTop) .LineStyle = TStyle .Color = TColor .TintAndShade = 0 .Weight = TWeight End With With temRn.Borders(xlEdgeBottom) .LineStyle = BStyle .Color = BColor .TintAndShade = 0 .Weight = BWeight End With With temRn.Borders(xlEdgeRight) .LineStyle = RStyle .Color = RColor .TintAndShade = 0 .Weight = RWeight End With With temRn.Borders(xlInsideVertical) .LineStyle = VStyle .Color = VColor .TintAndShade = 0 .Weight = VWeight End With With temRn.Borders(xlInsideHorizontal) .LineStyle = HStyle .Color = HColor .TintAndShade = 0 .Weight = HWeight End With End Sub Sub abc() MsgBox Len("temRn As Range, Optional LStyle = 1, Optional TStyle = 1, Optional BStyle = 1, Optional RStyle = 1, Optional VStyle = 1, Optional HStyle = 1, Optional LColor = 0, Optional TColor = 0, Optional BColor = 0, Optional RColor = 0, Optional VColor = 0, Optional HColor = 0, Optional LWeight = 2, Optional TWeight = 2, Optional BWeight = 2, Optional RWeight = 2, Optional VWeight = 2, Optional HWeight = 2") End Sub Function ZExcel(模板名, 文件名, 记录集, 起始行, 字段数, Optional 条件 As String) ‘ no use now Dim Excel1 As Object ‘ 定义引用 Microsoft Excel 的变量。 Dim dbs As Database Dim rst As Recordset Dim i, I1 As Integer Dim WJ1, WJ2, s As String ‘On Error GoTo err1 Set dbs = CurrentDb If InStr(1, UCase(模板名), ".XLS") > 0 Or InStr(1, UCase(模板名), ".XLSX") > 0 Then ‘有扩展名 WJ1 = CurrentProject.Path & "\" & 模板名 ‘模板文件名 （CurrentProject.Path为当前数据库的路径） Else WJ1 = CurrentProject.Path & "\" & 模板名 & ".XLS" ‘模板文件名 （CurrentProject.Path为当前数据库的路径） End If If InStr(1, UCase(文件名), ".XLS") > 0 Or InStr(1, UCase(文件名), ".XLSX") > 0 Then ‘有扩展名 WJ2 = CurrentProject.Path & "\" & 文件名 ‘目标文件名 Else WJ2 = CurrentProject.Path & "\" & 文件名 & ".XLS" ‘目标文件名 End If FileCopy WJ1, WJ2 ‘拷贝文件（模板文件拷贝成目标文件） Set Excel1 = GetObject(WJ2, "Excel.Sheet") ‘建立与Excel的连接变量 Excel1.Application.Visible = False ‘不打开Excel程序 Excel1.Parent.Windows(1).Visible = True ‘可见属性为真 If Nz(条件) <> "" Then 记录集 = "select * from " & 记录集 & " where " & 条件 Set rst = dbs.OpenRecordset(记录集, 2) ‘设置记录集 If Not rst.EOF Then rst.MoveFirst ‘记录集头部 If Not rst.EOF Then rst.MoveNext ‘记录集下移一条记录 If Not rst.EOF Then rst.MoveNext ‘记录集下移一条记录 s = Mid(Str(起始行 + 1), 2) & ":" & Mid(Str(起始行 + 1), 2) While Not rst.EOF ‘判断记录集是否结束 Excel1.Application.Rows(s).Select ‘选择Excel的行 Excel1.Application.Selection.Insert ‘插入行 rst.MoveNext ‘记录集下移一条记录 Wend ‘循环结束语句 If Not rst.EOF Then rst.MoveFirst ‘记录集头部 I1 = 起始行 ‘Excel的行 While Not rst.EOF ‘判断记录集是否结束 For i = 1 To 字段数 ‘按字段数循环 Excel1.Application.Cells(I1, i).Value = rst.Fields(i - 1) ‘在Excel列中填写数据 Next i ‘循环结束语句 rst.MoveNext ‘记录集下移一条记录 I1 = I1 + 1 ‘行加1 Wend ‘循环结束语句 Excel1.Save ‘保存Excel Excel1.Application.Quit ‘关闭Excel Set Excel1 = Nothing ‘清除内存变量 Set dbs = Nothing Set rst = Nothing ZExcel = True Exit Function err1: Set Excel1 = Nothing Set dbs = Nothing Set rst = Nothing ZExcel = False End Function