vba
'该类实现.NET与VBA及TXT文件的操作
'实现输出报表，导出图档等功能，及ERP数据导出
Option Explicit On
Option Strict On
Imports System.IO
Imports Microsoft.Office.Core
Imports System.Windows.Forms
Imports Microsoft.Office.Interop.Excel
Imports Microsoft.Office.Interop
Imports System.Runtime.InteropServices
Imports System.Collections.Generic
Imports System.Reflection
Imports System.Data.Common
Imports Thit.TiPDM.BRL.FileService.FileLoadFromDB
Imports Thit.TiPDM.BRL.Report.ReportCommfunc
Imports Thit.TiPDM.BRL.Report.BRLReport
Imports Thit.TiPDM.BRL.Document
Imports Thit.TiPDM.BRL.Product
Imports Thit.TiPDM.BRL.Part
Imports Thit.TiPDM.BRL.GlobalDefine.Define
Imports Thit.TiPDM.BRL.User
Imports Thit.TiPDM.DEL.Common
Imports Thit.TiPDM.DEL.Common.Data
Imports Thit.TiPDM.DEL.SystemParameter.DELSystem
Imports Thit.TiPDM.DEL.Document
Imports Thit.TiPDM.DEL.ClassProp
Imports Thit.TiPDM.DEL.Common.DelCommFunc
Imports Thit.TiPDM.DEL.User
Imports Thit.TiPDM.Common.Declare
Imports Thit.TiPDM.Common.Function.CommFunc
Imports Thit.TiPDM.UIL.Common
Namespace Thit.TiPDM.UIL.Report
''' <summary>
''' 导出文件
''' </summary>
''' <remarks></remarks>
Friend Class ClsOffice
''' <summary>
''' 导出普通报表
''' </summary>
''' <param name="LvData">列表</param>
''' <param name="Status">产品配置状态</param>
''' <param name="conprint">导出报表编号是否连续</param>
''' <param name="Filename">文件名</param>
''' <param name="PrdOrPartID">对象代号，零件或产品</param>
''' <param name="ColReportFields">属性集合</param>
''' <param name="PrdOrPart">零件或产品标识</param>
''' <param name="InnerCode">产品内码</param>
''' <remarks></remarks>
Public Shared Sub RunExcel(ByVal lvData As System.Windows.Forms.ListView, ByVal status As String, ByVal conPrint As Boolean, ByVal filename As String, ByVal prdOrPartID As String, ByVal colReportFields As Collection, ByVal prdOrPart As String, ByVal innerCode As String)
Dim objExcel As Excel.Application
Dim objBook As Excel.Workbook
Dim rng As Excel.Range
Dim product As New PDMProduct
Dim intBrow As Integer
Dim intErow As Integer
Dim intBeginX As Integer
Dim intBeginY As Integer
Dim intDBeginX As Integer
Dim intDBeginY As Integer
Dim intDataRow As Integer
Dim intItemCount As Integer '汇总纪录总数
Dim intPage As Integer '输出页计数器
Dim intPCount As Integer '输出总页数
Dim intItemIndex As Integer
Dim i As Integer
Dim j As Integer
Dim intX As Integer '表头的个数
Dim intY As Long '计数器
Dim intZ As Integer '计数器
Dim intRow As Integer
Dim stateIndex As Integer 'wyy(2005 - 1 - 5, 记录零件属性所在数据集的位置)
Dim intI As Integer
Dim partVer As Integer
Dim intTRows As Long
Dim signCell As String = String.Empty 'wyy 2006-8-4 用于判断定位文字是否找到
Dim productID As String = "" '大类产品代号
Dim categoryID As String = ""
Dim categoryName As String = ""
Dim add As String = ""
Dim totalEnd As String = ""
Dim dataBegin As String = ""
Dim dataEnd As String = ""
Dim tittle As String = ""
Dim titleend As String = ""
Dim time As String = ""
Dim tempValue As String = ""
Dim dotFileName As String = "" '报表模版名称
Dim partID As String = ""
Dim partName As String = ""
Dim isNext As Boolean 'wyy 2005-1-5，记录是否excel转向下一行
Dim isProtect As Boolean 'wyy 2006-5-8 增加变量
Dim isExist As Boolean '判断零件是否存在
Dim collPrdAttr As Collection = Nothing 'wyy 2006-3-30 增加产品属性集合
Dim clsProps As Collection '用户自定义零件属性代号集合
Dim prdIDandCode(,) As String
Dim actDataCol(20) As Integer
Dim person As New Person
On Error Resume Next
intTRows = lvData.Items.Count
objExcel = New Excel.Application
objExcel.Cursor = CType(XlMousePointer.xlWait, Excel.XlMousePointer)
objBook = objExcel.Workbooks.Open(filename)
objExcel.Visible = True
objExcel.ActiveWorkbook.SaveAs(g_PdmSystem.WorkFolder & "\" + prdOrPartID + "_" + CStr(Format(Now, "yyyy-MM-dd")) + ".xls")
File.Delete(filename)
'查找标志，计算位置坐标
totalEnd = objExcel.Cells.Find("<aeof*>", , XlFindLookIn.xlFormulas, XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
dataBegin = objExcel.Cells.Find("<dbof*>", , XlFindLookIn.xlFormulas, XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
dataEnd = objExcel.Cells.Find("<deof*>", , XlFindLookIn.xlFormulas, XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
tittle = objExcel.Cells.Find("<tbof*>", , XlFindLookIn.xlFormulas, XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
titleend = objExcel.Cells.Find("<teof*>", , XlFindLookIn.xlFormulas, XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
If objBook.ProtectWindows = True Then 'wyy 2006-3-30 如果碰到报表模版有锁定列的情况，需要先撤消保护
objExcel.ActiveWorkbook.Unprotect()
objBook.Activate()
isProtect = True
End If
If ReportParameter.IsProduct = True Then 'wyy 2006-8-4 写入之前，判断定位文字是否存在 'zzh2007-08-21得到自定义属性
product = New PDMProduct
If product.GetPrdId(prdIDandCode) Then
For a As Integer = 1 To UBound(prdIDandCode, 2)
If prdIDandCode(2, a).ToString = InnerCode Then
productID = prdIDandCode(1, a).ToString
product.GetCategory(productID, categoryID, categoryName)
collPrdAttr = ReportParameter.GetAttribute(categoryID, productID)
End If
Next
End If
For i = 1 To collPrdAttr.Count 'wyy 2006-3-30 输出产品自定义属性
signCell = objExcel.Cells.Find("<" & CType(collPrdAttr.Item(i), Collection)(1).ToString.Trim & "*>", , XlFindLookIn.xlFormulas, XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
If signCell <> "" Then
objExcel.Cells.Range(signCell).Activate()
objExcel.Cells.Replace("<" & CType(collPrdAttr.Item(i), Collection)(1).ToString.Trim & "*>", CType(collPrdAttr.Item(i), Collection)(5).ToString.Trim, XlLookAt.xlPart, XlSearchOrder.xlByRows, False)
End If
signCell = ""
Next
Else
productID = ""
End If
signCell = ""
If tittle <> "" And titleend <> "" Then
objExcel.Cells.Replace("<tbof*>", "", XlLookAt.xlPart, XlSearchOrder.xlByRows, False)
objExcel.Cells.Replace("<teof*>", "", XlLookAt.xlPart, XlSearchOrder.xlByRows, False)
End If
objExcel.Cells.Replace("<dbof*>", "", XlLookAt.xlPart, XlSearchOrder.xlByRows, False)
objExcel.Cells.Replace("<deof*>", "", XlLookAt.xlPart, XlSearchOrder.xlByRows, False)
objExcel.Cells.Replace("<aeof*>", "", XlLookAt.xlPart, XlSearchOrder.xlByRows, False)
intBrow = CInt(FindRowNO(dataBegin)) '数据开始行数
intErow = CInt(FindRowNO(dataEnd)) '数据结束行数
intDataRow = intErow - intBrow + 1 '数据行数
intErow = CInt(FindRowNO(totalEnd)) '页行数
If tittle <> "" And titleend <> "" Then
intBeginX = CInt(FindRowNO(tittle)) 'Title开始行
intBeginY = CInt(FindColNO(tittle)) 'Title开始列
End If
intDBeginX = CInt(FindRowNO(dataBegin)) '数据开始行
intDBeginY = CInt(FindColNO(dataBegin)) '数据开始列
intItemCount = CInt(intTRows)
intItemIndex = 1
If intItemCount Mod intDataRow = 0 Then '计算总页数
intPCount = CInt(intItemCount / intDataRow)
Else
intPCount = CInt(Fix(intItemCount / intDataRow) + 1)
End If
i = 1
intX = colReportFields.Count '初始化表头
If tittle <> "" And titleend <> "" Then
rng = objExcel.Range(tittle)
actDataCol(i) = rng.Column
intRow = rng.Row
While rng.Column < CDbl(FindColNO(titleend))
rng.Activate()
If CBool(rng.MergeCells) Then
j = objExcel.ActiveCell.MergeArea.Cells.Count
Else
j = objExcel.ActiveCell.Column + 1
End If
i = i + 1
actDataCol(i) = CType((rng.MergeArea.Cells(j)), Integer) + 1
rng = objExcel.Cells.Range(intRow, actDataCol(i))
End While
For intY = 1 To intX
j = actDataCol(CInt(intY))
rng.Cells.Item(intBeginX, j) = CType(colReportFields.Item(i), Collection)(1).ToString.Trim
Next intY
End If
If PrdOrPart = "prt" Then
partID = prdOrPartID
partName = PartCommFunc.GetPartName(partID)
partVer = CInt(PartCommFunc.GetPartVer(partID, isExist))
End If
'填写表头表尾信息
' 编号 wyy 2003-8-13, id, name，改为PartID, partname,取报表列表框中第一行的内容
signCell = objExcel.Cells.Find("<PartID*>", , XlFindLookIn.xlFormulas, _
XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
If signCell <> "" Then
objExcel.Cells.Range(signCell).Activate()
objExcel.ActiveCell.Replace("<PartID*>", Trim(partID), XlLookAt.xlPart, _
XlSearchOrder.xlByRows, False)
End If
signCell = ""
'名称
signCell = objExcel.Cells.Find("<partname*>", , XlFindLookIn.xlFormulas, _
XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
If signCell <> "" Then
objExcel.Cells.Range(signCell).Activate()
objExcel.ActiveCell.Replace("<partname*>", Trim(partName), XlLookAt.xlPart, _
XlSearchOrder.xlByRows, False)
End If
signCell = ""
'wyy 2006-8-18 增加部件版本输出
signCell = objExcel.Cells.Find("<partver*>", , XlFindLookIn.xlFormulas, _
XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
If signCell <> "" Then
rng.Range(signCell).Activate()
objExcel.ActiveCell.Replace("<partver*>", partVer, XlLookAt.xlPart, _
XlSearchOrder.xlByRows, False)
End If
signCell = ""
'wyy 2006-5-8 增加产品配置状态号输出
signCell = objExcel.Cells.Find("<statusid*>", , XlFindLookIn.xlFormulas, XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
If signCell <> "" Then
objExcel.Cells.Range(signCell).Activate()
objExcel.ActiveCell.Replace("<statusid*>", status, XlLookAt.xlPart, _
XlSearchOrder.xlByRows, False)
End If
signCell = ""
'填表人
signCell = objExcel.Cells.Find("<designer*>", , XlFindLookIn.xlFormulas, XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
If signCell <> "" Then
objExcel.Cells.Range(signCell).Activate()
Person.LoadAllIdAndName()
objExcel.Cells.Replace("<designer*>", IIf(Person.GetPsnName(g_PdmSystem.CurUser) = "", g_PdmSystem.CurUser, Person.GetPsnName(g_PdmSystem.CurUser)), XlLookAt.xlPart, XlSearchOrder.xlByRows, False)
End If
signCell = ""
'时间
time = CDate(datNow()).Date.ToString 'wyy 2003-7-23, datNow取服务器时间
signCell = objExcel.Cells.Find("<now*>", , XlFindLookIn.xlFormulas, XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
If signCell <> "" Then
objExcel.Cells.Range(signCell).Activate()
objExcel.Cells.Replace("<now*>", time, XlLookAt.xlPart, XlSearchOrder.xlByRows, False)
objExcel.ActiveCell.AutoFit()
End If
signCell = ""
time = ""
'rzy2007-2-27加：输出零件自定义属性。要输出的零件属性在模板中标识为“part”+零件属性代号。
clsProps = ReportParameter.GetAttribute("partrevision", partID, partVer)
If clsProps.Count <> 0 Then
For i = 1 To clsProps.Count
'生效时间
If CType(clsProps.Item(i), Collection)(1).ToString = "effecttime" Then
time = CType(clsProps.Item(i), Collection)(5).ToString.Trim
If time = "" Then
time = Left(CDate(datNow()).Date.ToString, 10)
Else
time = Left(CStr(CDate(time).Date), 10)
End If
signCell = objExcel.Cells.Find("<efftime*>", , XlFindLookIn.xlFormulas, XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
If signCell <> "" Then
objExcel.Cells.Range(signCell).Activate()
objExcel.Cells.Replace("<efftime*>", time, XlLookAt.xlPart, XlSearchOrder.xlByRows, False)
objExcel.ActiveCell.ShrinkToFit = True
End If
signCell = ""
End If
signCell = objExcel.Cells.Find("<part" & CType(clsProps.Item(i), Collection)(1).ToString.Trim & "*>", , XlFindLookIn.xlFormulas, XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
If signCell <> "" Then
CType(objExcel.Sheets("Sheet1"), Worksheet).Cells.Range(signCell).Activate()
objExcel.Cells.Range(signCell).Replace("<part" & CType(clsProps.Item(i), Collection)(1).ToString.Trim & "*>", CType(clsProps.Item(1), Collection)(5).ToString, XlLookAt.xlPart, XlSearchOrder.xlByRows, False)
End If
signCell = ""
Next
End If
clsProps = Nothing
If intPCount > 1 Then
objExcel.Range("A1:" + totalEnd).Copy()
End If
Dim CurPages As Integer '当前总页数
Dim RemainPages As Integer '剩余总页数=总页数-当前总页数
CurPages = 1
For intPage = 1 To intPCount '复制模板
If CurPages * 2 < intPCount Then
objExcel.Cells.Range("1:" + CStr(intErow * CurPages)).Select()
CType(objExcel.Selection, Excel.Range).Copy()
CType(objExcel.ActiveSheet, Worksheet).HPageBreaks.Add(objExcel.Range("A" + CStr(CurPages * intErow)))
CType(objExcel.Rows(CStr(CurPages * intErow + 1)), Excel.Range).Select()
CType(objExcel.ActiveSheet, Worksheet).Paste()
CurPages = CInt(2 ^ intPage)
Else
RemainPages = intPCount - CurPages
If RemainPages = 0 Then
Exit For
End If
objExcel.Range("1:" + CStr(intErow * RemainPages)).Select()
CType(objExcel.Selection, Excel.Range).Copy()
CType(objExcel.ActiveSheet, Worksheet).HPageBreaks.Add(objExcel.Range("A" + CStr(CurPages * intErow)))
CType(objExcel.Rows(CStr(CurPages * intErow + 1)), Excel.Range).Select()
CType(objExcel.ActiveSheet, Worksheet).Paste()
Exit For
End If
Next
CType(objExcel.Worksheets, Worksheet).PageSetup.PrintArea = ""
CType(objExcel.Rows(intPage * intErow), Excel.Range).PageBreak = XlPageBreak.xlPageBreakManual
intItemIndex = 1
intI = 1
stateIndex = colReportFields.Count
For intPage = 1 To intPCount
add = ""
If (intPage * intErow) > 99000 Then Exit For
add = objExcel.Cells.Find("<page*>", objExcel.Range("A" + CStr(IIf(intPage = 1, 1, (intPage - 1) * intErow))), XlFindLookIn.xlFormulas, XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
If add <> "" Then
CType(objExcel.Sheets("sheet1"), Worksheet).Range("A" & CStr(IIf(intPage = 1, 1, (intPage - 1) * intErow)), add).Replace("<page*>", "第" + CStr(intPage) + "页 " + "共" + CStr(intPCount) + "页", XlLookAt.xlPart, XlSearchOrder.xlByRows, False)
CType(objExcel.Sheets("sheet1"), Worksheet).Range(add).Select()
End If
objExcel.Range(add).Activate()
objExcel.ActiveCell.ShrinkToFit = True
If conPrint = True Then '编号连续
For intY = 1 To CInt(FindRowNO(dataEnd)) - intBrow + 1
objExcel.Cells(intDBeginX + (intPage - 1) * intErow + intY - 1, intDBeginY - 1) = intI
intI = intI + 1
Next intY
End If
For intY = 0 To intDataRow - 1 '向Excel中填写数据
NextStep:
tempValue = GetLVData(CInt((intPage - 1) * intDataRow + intY), lvData)
isNext = True
If Split(tempValue, "@@")(stateIndex).Length <> 0 Then 'wyy 2005-1-5，三一需求，进行零件有效性判断，只报出未生效零件
For intZ = 0 To intX - 1
j = intZ 'actdataCol(
'rzy2006-4-4修改：如值为空，则不向excel中写入数据以提高效率
If Not Split(tempValue, "@@")(intZ) Is Nothing Then
If Trim(Split(tempValue, "@@")(intZ)) <> "" Then
objExcel.Cells(intDBeginX + (intPage - 1) * intErow + intY, intDBeginY + j) = Trim$(Split(tempValue, "@@")(intZ))
End If
End If
' objexcel.Sheets("sheet1").Cells(intDBeginX + (intPage - 1) * intErow + intY - 1, intDBeginY + j - 1) = Trim$(IIf(IsNull(Split(strTemp, "@@")(intZ - 1)), "", Split(strTemp, "@@")(intZ - 1)))
Next intZ
intItemIndex = intItemIndex + 1
isNext = True
Else
isNext = False
End If
If intItemIndex > intItemCount Then
Exit For
End If
If Not isNext Then 'wyy 2005-1-5，增加这个判断，三一需求，增加报出未生效零件，数据集中的有些零件可能不报出来，所以就不向下走一行，在本行填加记录
GoTo NextStep
End If
Next intY
Next intPage
'清空所有标志字符 like <*>
signCell = objExcel.Cells.Find("<*>", , XlFindLookIn.xlFormulas, XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
If signCell <> "" Then
objExcel.Cells.Replace("<*>", "", XlLookAt.xlPart, XlSearchOrder.xlByRows, False)
End If
signCell = ""
If isProtect = True Then
objBook.Protect(True, True, True) 'wyy 2006-3-30 如果碰到报表模版有锁定列的情况，报表导出结束后，再加上保护
objBook.Protect()
End If
'ObjExcel.ScreenUpdating = True
objExcel.Cursor = Excel.XlMousePointer.xlDefault
MsgBox("导出完毕.", MsgBoxStyle.Information Or MsgBoxStyle.OkOnly)
End Sub
''' <summary>
''' 'rzy2005-11-30为四机加：SAP集成：导出SAP所需的EXCEL文件
''' </summary>
''' <param name="TxtSap"></param>
''' <param name="fileName"></param>
''' <remarks></remarks>
Friend Shared Sub RunExcelSAP(ByVal txtSap As String, Optional ByVal fileName As String = "")
Dim objExcel As Excel.Application
Dim objBook As Excel.Workbook
Dim dataReader As BaseDataReader
Dim DirName As String
Dim PathName As String
Dim TempValue As String
Dim StrSQL As String
Dim Gongyiluxian As String
Dim Zhunbeishijian As String
Dim Jiqishijian As String
Dim Rengongshijian As String
Dim i As Long
Dim j As Long
Dim pos As Long
Dim pos1 As Long
Dim pos2 As Long
Dim StrSign As String
If Trim(txtSap) = "" Then
MsgBox("请选择导出类型", MsgBoxStyle.Information Or MsgBoxStyle.OkOnly)
Exit Sub
End If
Try
' If BrowseForDir(0, "请选择文件路径", DirName) = 0 Then
' Exit Sub
' End If
' PathName = Left$(DirName, InStr(DirName, Chr(0)) - 1) & "\" & Format(Now, "yymmddhhmm")
DirName = fileName
PathName = Trim(DirName) & "\" & Now.ToString
objExcel = New Excel.Application
objExcel.Cursor = CType(XlMousePointer.xlWait, Excel.XlMousePointer)
objExcel.ScreenUpdating = False
StrSign = LCase(Trim(txtSap))
objBook = objExcel.Workbooks.Add
If StrSign = "all" Or StrSign = "item" Then
fileName = PathName & "item" & g_PdmSystem.CurUser & ".xls"
'表头
objExcel.ScreenUpdating = False
objExcel.Cells.Item(1, 1) = "MATNR"
objExcel.Cells.Item(1, 2) = "MTART"
objExcel.Cells.Item(1, 3) = "MEINS"
objExcel.Cells.Item(1, 4) = "MAKTX"
objExcel.Cells.Item(1, 5) = "MERKS"
objExcel.Cells.Item(1, 6) = "DISMM"
objExcel.Cells.Item(1, 7) = "BESKZ"
objExcel.Cells.Item(1, 8) = "DISPO"
objExcel.Cells.Item(1, 9) = "FHORI"
objExcel.Cells.Item(1, 10) = "DISLS"
objExcel.Cells.Item(1, 11) = "MTVFP"
StrSQL = "select distinct * from itemtmp1 where status='itemadd'"
dataReader = New BaseDataReader(StrSQL)
TempValue = "A1:" & Chr(Asc("A") + 11) & CStr(dataReader.FieldCount + 1)
objExcel.Range(TempValue).NumberFormat = "@"
i = 1
If dataReader.Read Then
i = i + 1
objExcel.Cells.Item(i, 1) = Trim(dataReader.Item("PartID").ToString)
If IsDBNull(dataReader.Item("wuliaomiaoshu").ToString.Trim) Then
objExcel.Cells.Item(i, 2) = ""
Else
objExcel.Cells.Item(i, 2) = ChangePartType(Trim(dataReader.Item("wuliaomiaoshu").ToString))
End If
objExcel.Cells.Item(i, 3) = UCase(Trim(dataReader.Item("jibendanwei").ToString))
objExcel.Cells.Item(i, 4) = IIf(IsDBNull(dataReader.Item("wuliaomiaoshu").ToString.Trim), "", dataReader.Item("wuliaomiaoshu").ToString)
objExcel.Cells.Item(i, 5) = "1000"
objExcel.Cells.Item(i, 6) = "PD"
objExcel.Cells.Item(i, 7) = "E"
objExcel.Cells.Item(i, 8) = "000"
objExcel.Cells.Item(i, 9) = "000"
objExcel.Cells.Item(i, 10) = "EX"
objExcel.Cells.Item(i, 11) = "1"
dataReader.Close()
objExcel.ActiveWorkbook.SaveAs(fileName)
objExcel.ActiveWorkbook.Close()
objExcel = Nothing
Else
Exit Sub
End If
End If
If StrSign = "all" Or StrSign = "technics" Then
'工艺路线
fileName = PathName & "technology" & g_PdmSystem.CurUser & ".xls"
'表头
'ObjExcel = VBA.CreateObject("excel.application")
'ExcelSheet = VBA.CreateObject("excel.sheet")
'ExcelSheet.Application.Visible = True
objExcel.Cells.Item(1, 1) = "生产物料工艺主数据收集表"
objExcel.Cells.Item(2, 1) = "图号"
objExcel.Cells.Item(2, 2) = "名称"
objExcel.Cells.Item(2, 3) = "SAP工序"
objExcel.Cells.Item(2, 4) = "替代"
objExcel.Cells.Item(2, 5) = "SAP替代工序"
objExcel.Cells.Item(2, 6) = "工作中心"
objExcel.Cells.Item(2, 7) = "工序描述"
objExcel.Cells.Item(2, 8) = "准备时间"
objExcel.Cells.Item(2, 9) = "机器时间"
objExcel.Cells.Item(2, 10) = "人工时间"
objExcel.Cells.Item(2, 11) = "等待时间"
objExcel.Cells.Item(2, 12) = "最小发送量/单位"
objExcel.Cells.Item(2, 13) = "分解数"
objExcel.Cells.Item(2, 13) = "分解数"
objExcel.Cells.Item(2, 14) = "数据收集人"
objExcel.Cells.Item(2, 15) = "外协单位"
objExcel.Cells.Item(2, 16) = "备注"
StrSQL = "select distinct * from itemtmp1 where status='itemadd'"
dataReader = New BaseDataReader(StrSQL)
pos2 = dataReader.FieldCount + 2
TempValue = "A1:" & Chr(Asc("A") + 11) & CStr(dataReader.FieldCount + 2)
objExcel.Range(TempValue).NumberFormat = "@"
i = 2
If dataReader.Read() Then
j = 0
pos = 1
Gongyiluxian = IIf(dataReader.Item("Gongyiluxian") Is Nothing, "", dataReader.Item("Gongyiluxian").ToString).ToString.Trim
Zhunbeishijian = IIf(dataReader.Item("Zhunbeishijian") Is Nothing, "", dataReader.Item("Zhunbeishijian").ToString).ToString.Trim
Jiqishijian = IIf(dataReader.Item("Jiqishijian") Is Nothing, "", dataReader.Item("Jiqishijian").ToString).ToString.Trim
Rengongshijian = IIf(dataReader.Item("Rengongshijian") Is Nothing, "", dataReader.Item("Rengongshijian").ToString).ToString.Trim
Do While pos > 0 Or Len(Gongyiluxian) > 0
j = j + 1
i = i + 1
If i > pos2 Then
TempValue = "A" & CStr(pos2 + 1) & ":" & Chr(Asc("A") + 11) & CStr(pos2 + 50)
objExcel.Range(TempValue).NumberFormat = "@"
pos2 = pos2 + 50
End If
pos = InStr(Gongyiluxian, "/")
objExcel.Cells.Item(i, 1) = Trim(dataReader.Item("PartID").ToString)
objExcel.Cells.Item(i, 2) = IIf(dataReader.Item("Wuliaomiaoshu") Is Nothing, "", dataReader.Item("Wuliaomiaoshu").ToString)
objExcel.Cells.Item(i, 3) = CStr(10 * j)
objExcel.Cells.Item(i, 4) = ""
objExcel.Cells.Item(i, 5) = ""
objExcel.Cells.Item(i, 6) = ""
objExcel.Cells.Item(i, 11) = ""
objExcel.Cells.Item(i, 12) = ""
objExcel.Cells.Item(i, 13) = "1"
objExcel.Cells.Item(i, 14) = ""
objExcel.Cells.Item(i, 15) = ""
objExcel.Cells.Item(i, 16) = ""
If pos > 0 Then
objExcel.Cells.Item(i, 7) = Trim(Left(Gongyiluxian, CInt(pos - 1)))
Gongyiluxian = Trim(Mid(Gongyiluxian, CInt(pos + 1)))
Else
objExcel.Cells.Item(i, 7) = Gongyiluxian
Gongyiluxian = ""
End If
pos1 = InStr(Zhunbeishijian, "/")
If pos1 > 0 Then
objExcel.Cells.Item(i, 8) = Trim(Left(Zhunbeishijian, CInt(pos1 - 1)))
Zhunbeishijian = Trim(Mid(Zhunbeishijian, CInt(pos + 1)))
Else
objExcel.Cells.Item(i, 8) = Zhunbeishijian
Zhunbeishijian = ""
End If
pos1 = InStr(Jiqishijian, "/")
If pos1 > 0 Then
objExcel.Cells.Item(i, 9) = Trim(Left(Jiqishijian, CInt(pos1 - 1)))
Jiqishijian = Trim(Mid(Jiqishijian, CInt(pos + 1)))
Else
objExcel.Cells.Item(i, 9) = Jiqishijian
Jiqishijian = ""
End If
pos1 = InStr(Rengongshijian, "/")
If pos1 > 0 Then
objExcel.Cells.Item(i, 10) = Trim(Left(Rengongshijian, CInt(pos1 - 1)))
Rengongshijian = Trim(Mid(Rengongshijian, CInt(pos + 1)))
Else
objExcel.Cells.Item(i, 10) = Rengongshijian
Rengongshijian = ""
End If
Loop
i = i + 1
dataReader.Close()
Else
Exit Sub
End If
objBook.SaveAs(fileName)
objBook.Close()
objExcel = Nothing
End If
Dim strTemp1() As String
If StrSign = "all" Then
ReDim strTemp1(4)
strTemp1(1) = "bomdel"
strTemp1(2) = "bomnew"
strTemp1(3) = "bomadd"
strTemp1(4) = "bommod"
ElseIf StrSign = "bomdel" Or StrSign = "bomnew" Or StrSign = "bomadd" Or StrSign = "bommod" Then
ReDim strTemp1(1)
strTemp1(1) = StrSign
Else
GoTo exitOk
End If
For pos = 1 To UBound(strTemp1)
fileName = PathName & strTemp1(CInt(pos)) & g_PdmSystem.CurUser & ".xls"
'表头
objExcel.Cells.Item(1, 1) = "PMATNR"
objExcel.Cells.Item(1, 2) = "MATNR"
objExcel.Cells.Item(1, 3) = "QTY"
objExcel.Cells.Item(1, 4) = "MEINS"
StrSQL = "select * from bomtmp1 where status='" & strTemp1(CInt(pos)) & "'"
dataReader = New BaseDataReader(StrSQL)
TempValue = "A1:" & Chr(Asc("A") + 11) & CStr(dataReader.FieldCount + 1)
objExcel.Range(TempValue).NumberFormat = "@"
i = 1
If dataReader.Read() Then
i = i + 1
objExcel.Cells.Item(i, 1) = dataReader.Item("superid").ToString.Trim
objExcel.Cells.Item(i, 2) = dataReader.Item("subid").ToString.Trim
objExcel.Cells.Item(i, 3) = dataReader.Item("Number").ToString.Trim
objExcel.Cells.Item(i, 4) = UCase(dataReader.Item("jibendanwei").ToString.Trim)
dataReader.Close()
Else
Exit Sub
End If
objExcel.ScreenUpdating = True
objBook.SaveAs(fileName)
objBook.Close()
objBook = Nothing
objExcel = Nothing
Next pos
exitOk:
objExcel.Cursor = CType(XlMousePointer.xlDefault, Excel.XlMousePointer)
MsgBox("导出完毕", MsgBoxStyle.Information Or MsgBoxStyle.OkOnly)
Exit Sub
Catch ex As Exception
objExcel.Cursor = CType(XlMousePointer.xlDefault, Excel.XlMousePointer)
MsgBox("导出失败.原因：" & Err.Description, MsgBoxStyle.Information Or MsgBoxStyle.OkOnly)
objBook.Close()
objBook = Nothing
objExcel = Nothing
Exit Sub
End Try
End Sub
''' <summary>
''' 改变类型标识
''' </summary>
''' <param name="PartType"></param>
''' <returns></returns>
''' <remarks></remarks>
Friend Shared Function ChangePartType(ByVal PartType As String) As String
'rzy2005-12-01为四机加。SAP集成
'零件类型有：产品（以XJ*、GJ*、HS*、YL*、ZJ*等开头）、自制零件（P*）、钻修组件（Z*）、固压组件（G*）、原材料（01*）、外购件（02*~56*），在交换时由交换程序自动转换成原材料、半成品、产成品，产品对应产成品，原材料对应原材料，其余对应半成品
Dim strPartType As String
strPartType = LCase(PartType)
If strPartType = "产品" Or strPartType = "产成品" Then
ChangePartType = "FERT"
ElseIf strPartType = "原材料" Then
ChangePartType = "ROH"
Else
ChangePartType = "HALB"
End If
End Function
''' <summary>
''' 导出工艺路线
''' </summary>
''' <remarks></remarks>
Friend Shared Sub OutputTechnologyToExcel()
Dim StrSQL As String
Dim objExcel As Excel.Application
Dim dataReader As BaseDataReader
Dim con As DbConnection
Dim Trans As DbTransaction
'连接PDM数据库
'cnnPDM = New ADODB.Connection
'cnnPDM.ConnectionTimeout = 300
'cnnPDM.Open(Cnn)
Con = AccessDatabase.CreateConnection
Con.Open()
If Con.State = 0 Then
MsgBox("连接PDM数据库失败，本次操作不能进行", MsgBoxStyle.Information Or MsgBoxStyle.OkOnly)
Exit Sub
'Else
' Cnn.CommandTimeou = 300
End If
Try
AccessDatabase.ExcuteReduceTransIsolation()
Trans = Con.BeginTransaction
StrSQL = "delete from itemtmpall where pdmuser='" & g_PdmSystem.CurUser & "'"
AccessDatabase.ExecuteNonQuery(StrSQL)
StrSQL = "insert into itemtmpall " & _
"SELECT distinct '" & g_PdmSystem.CurUser & "', r.pdm_report_subid, r.pdm_report_subname, v.code, v.technologline, " & _
"v.preparetime , v.machinetime, v.manualtime " & _
"FROM pdm_bom_report r ,partrevision v " & _
"where r.pdm_report_subid = v.id and v.technologline<>'' and " & _
"r.pdm_report_user = '" & g_PdmSystem.CurUser & "'"
AccessDatabase.ExecuteNonQuery(StrSQL)
Trans.Commit()
Dim FileName As String
Dim DirName As String
Dim TempValue As String
Dim Gongyiluxian As String
Dim Zhunbeishijian As String
Dim Jiqishijian As String
Dim Rengongshijian As String
Dim i As Long
Dim j As Long
Dim pos As Long
Dim pos1 As Long
Dim pos2 As Long
DirName = UilCommFunc.GetDownLoadDir(0, "请选择文件路径")
If DirName = "" Then
Exit Sub
End If
'DirName = Microsoft.VisualBasic.Left(DirName1, InStr(DirName1, Chr(0)) - 1).Trim.ToString
'Me.MousePointer = 11
'工艺路线
If DirName.EndsWith("\") = True Then
FileName = DirName & "工艺路线.xls"
Else
FileName = DirName & "\工艺路线.xls"
End If
'表头
'objexcel = VBA.CreateObject("excel.application")
'ExcelSheet = VBA.CreateObject("excel.sheet")
'ExcelSheet.Application.Visible = True
ObjExcel.Cells.Item(1, 1) = "生产物料工艺主数据收集表"
ObjExcel.Cells.Item(2, 1) = "零件代号"
ObjExcel.Cells.Item(2, 2) = "零件名称名称"
ObjExcel.Cells.Item(2, 3) = "旧图号"
ObjExcel.Cells.Item(2, 4) = "工艺路线"
ObjExcel.Cells.Item(2, 5) = "准备时间"
ObjExcel.Cells.Item(2, 6) = "机器时间"
ObjExcel.Cells.Item(2, 7) = "人工时间"
StrSQL = "select * from itemtmpall where pdmuser='" & g_PdmSystem.CurUser & "'"
'rstX = New ADODB.Recordset
'rstX.Open(StrSQL, cnnPDM, adOpenStatic)
datareader = New BaseDataReader(StrSQL)
If datareader.Read = False Then
datareader.Close()
MsgBox("导出数据为空.本次导出的所有零件都没有工艺路线信息", MsgBoxStyle.Information Or MsgBoxStyle.OkOnly)
'Me.MousePointer = 0
Exit Sub
End If
pos2 = datareader.FieldCount + 2
TempValue = "A1:" & Chr(Asc("A") + 11) & CStr(datareader.FieldCount + 2)
ObjExcel.Range(TempValue).NumberFormat = "@"
i = 2
Do While datareader.Read
j = 0
pos = 1
Gongyiluxian = IIf(IsDBNull(datareader.Item("technologline").ToString.Trim), "", datareader.Item("technologline").ToString.Trim).ToString.Trim
Zhunbeishijian = IIf(IsDBNull(datareader.Item(" preparetime").ToString.Trim), "", datareader.Item(" preparetime").ToString.Trim).ToString.Trim
Jiqishijian = IIf(IsDBNull(datareader.Item(" machinetime").ToString.Trim), "", datareader.Item(" machinetime").ToString.Trim).ToString.Trim
Rengongshijian = IIf(IsDBNull(datareader.Item("manualtime").ToString.Trim), "", datareader.Item("manualtime").ToString.Trim).ToString.Trim
Do While pos > 0 Or Len(Gongyiluxian) > 0
j = j + 1
i = i + 1
If i > pos2 Then
TempValue = "A" & CStr(pos2 + 1) & ":" & Chr(Asc("A") + 11) & CStr(pos2 + 50)
ObjExcel.Range(TempValue).NumberFormat = "@"
pos2 = pos2 + 50
End If
pos = InStr(Gongyiluxian, "/")
ObjExcel.Cells.Item(i, 1) = datareader.Item("ID").ToString.Trim
ObjExcel.Cells.Item(i, 2) = IIf(IsDBNull(datareader.Item("Name").ToString.Trim), "", datareader.Item("Name").ToString.Trim)
ObjExcel.Cells.Item(i, 3) = IIf(IsDBNull(datareader.Item("code").ToString.Trim), "", datareader.Item("code").ToString.Trim)
If pos > 0 Then
ObjExcel.Cells.Item(i, 4) = Microsoft.VisualBasic.Left(Gongyiluxian, CInt(pos - 1)).Trim.ToString
Gongyiluxian = Mid(Gongyiluxian, CInt(pos + 1)).Trim.ToString
Else
ObjExcel.Cells.Item(i, 4) = Gongyiluxian
Gongyiluxian = ""
End If
pos1 = InStr(Zhunbeishijian, "/")
If pos1 > 0 Then
ObjExcel.Cells.Item(i, 5) = Microsoft.VisualBasic.Left(Zhunbeishijian, CInt(pos1 - 1)).Trim.ToString
Zhunbeishijian = Mid(Zhunbeishijian, CInt(pos1 + 1)).Trim.ToString
Else
ObjExcel.Cells.Item(i, 5) = Zhunbeishijian
Zhunbeishijian = ""
End If
pos1 = InStr(Jiqishijian, "/")
If pos1 > 0 Then
ObjExcel.Cells.Item(i, 6) = Microsoft.VisualBasic.Left(Jiqishijian, CInt(pos1 - 1)).Trim.ToString
Jiqishijian = Mid(Jiqishijian, CInt(pos1 + 1)).Trim.ToString
Else
ObjExcel.Cells.Item(i, 6) = Jiqishijian
Jiqishijian = ""
End If
pos1 = InStr(Rengongshijian, "/")
If pos1 > 0 Then
ObjExcel.Cells.Item(i, 7) = Microsoft.VisualBasic.Left(Rengongshijian, CInt(pos1 - 1)).Trim.ToString
Rengongshijian = Mid(Rengongshijian, CInt(pos1 + 1)).Trim.ToString
Else
ObjExcel.Cells.Item(i, 7) = Rengongshijian
Rengongshijian = ""
End If
Loop
i = i + 1
Loop
datareader.Close()
' objexcel.SaveWorkspace FileName
ObjExcel.ActiveWorkbook.SaveAs(FileName)
ObjExcel.Workbooks.Open(FileName)
'ExcelSheet = Nothing
ObjExcel = Nothing
exitOk:
'Me.MousePointer = 0
MsgBox("导出完毕", MsgBoxStyle.Information Or MsgBoxStyle.OkOnly)
Exit Sub
Catch ex As Exception
'Me.MousePointer = 0
'ExcelSheet.Close()
'ExcelSheet = Nothing
ObjExcel = Nothing
Trans.Rollback()
MsgBox("导出工艺路线失败." & Chr(10) & "失败原因：" & Err.Description)
Exit Sub
End Try
End Sub
''' <summary>
''' 导出EXCEL到ERP
''' </summary>
''' <param name="CmbSAP"></param>
''' <param name="fileName"></param>
''' <remarks></remarks>
Friend Shared Sub OutputExcelSAP(ByVal CmbSAP As String, Optional ByVal fileName As String = "")
'rzy2005-11-30为四机加：SAP集成：导出SAP所需的EXCEL文件
Dim objExcel As Excel.Application
Dim objBook As Excel.Workbook
Dim DirName As String
Dim PathName As String
Dim TempValue As String
Dim Gongyiluxian As String
Dim Zhunbeishijian As String
Dim Jiqishijian As String
Dim Rengongshijian As String
Dim i As Long
Dim j As Long
Dim pos As Long
Dim pos1 As Long
Dim pos2 As Long
Dim StrSign As String
ObjExcel = New Excel.Application
Dim StrSQL As String = "select distinct * from itemtmp1 where status='itemadd'"
Dim datareader As New BaseDataReader(StrSQL)
If CmbSAP.Trim.ToString = "" Then
MsgBox("请选择导出类型", MsgBoxStyle.Information Or MsgBoxStyle.OkOnly)
Exit Sub
End If
Try
' If BrowseForDir(0, "请选择文件路径", DirName) = 0 Then
' Exit Sub
' End If
' PathName = Left$(DirName, InStr(DirName, Chr(0)) - 1) & "\" & Format(Now, "yymmddhhmm")
DirName = fileName
PathName = DirName.Trim.ToString & "\" & Format(Now, "yyMMddHHmm")
'my. = 11
StrSign = LCase(CmbSAP.Trim.ToString)
'ObjExcel.ScreenUpdating = False
If StrSign = "all" Or StrSign = "item" Then
fileName = PathName & "item" & g_PdmSystem.CurUser & ".xls"
ObjExcel.Cells.Item(1, 1) = "MATNR"
ObjExcel.Cells.Item(1, 2) = "MTART"
ObjExcel.Cells.Item(1, 3) = "MEINS"
ObjExcel.Cells.Item(1, 4) = "MAKTX"
ObjExcel.Cells.Item(1, 5) = "MERKS"
ObjExcel.Cells.Item(1, 6) = "DISMM"
ObjExcel.Cells.Item(1, 7) = "BESKZ"
ObjExcel.Cells.Item(1, 8) = "DISPO"
ObjExcel.Cells.Item(1, 9) = "FHORI"
ObjExcel.Cells.Item(1, 10) = "DISLS"
ObjExcel.Cells.Item(1, 11) = "MTVFP"
If datareader.Read Then
TempValue = "A1:" & Chr(Asc("A") + 11) & CStr(datareader.FieldCount + 1)
ObjExcel.Range(TempValue).NumberFormat = "@"
i = 1
While datareader.Read
i = i + 1
ObjExcel.Cells(i, 1) = datareader.Item("PartID").ToString.Trim
If IsDBNull(datareader.Item("Wuliaoleixing").ToString.Trim) Then
ObjExcel.Cells(i, 2) = ""
Else
ObjExcel.Cells(i, 2) = ChangePartType(datareader.Item("Wuliaoleixing").ToString.Trim)
End If
ObjExcel.Cells.Item(i, 3) = UCase(datareader.Item("jibendanwei").ToString.Trim)
ObjExcel.Cells.Item(i, 4) = IIf(IsDBNull(datareader.Item("Wuliaomiaoshu")), "", datareader.Item("Wuliaomiaoshu"))
ObjExcel.Cells.Item(i, 5) = "1000"
ObjExcel.Cells.Item(i, 6) = "PD"
ObjExcel.Cells.Item(i, 7) = "E"
ObjExcel.Cells.Item(i, 8) = "000"
ObjExcel.Cells.Item(i, 9) = "000"
ObjExcel.Cells.Item(i, 10) = "EX"
ObjExcel.Cells.Item(i, 11) = "1"
End While
datareader.Close()
ObjBook.SaveAs(fileName)
ObjBook.Close()
ObjBook = Nothing
ObjExcel = Nothing
Else
datareader.Close()
'ExcelSheet = Nothing
ObjExcel = Nothing
End If
End If
If StrSign = "all" Or StrSign = "technics" Then
'工艺路线
fileName = PathName & "technology" & g_PdmSystem.CurUser & ".xls"
'表头
'objexcel = VBA.CreateObject("excel.application")
'ExcelSheet = VBA.CreateObject("excel.sheet")
'ExcelSheet.Application.Visible = True
ObjExcel.Cells.Item(1, 1) = "生产物料工艺主数据收集表"
ObjExcel.Cells.Item(2, 1) = "图号"
ObjExcel.Cells.Item(2, 2) = "名称"
ObjExcel.Cells.Item(2, 3) = "SAP工序"
ObjExcel.Cells.Item(2, 4) = "替代"
ObjExcel.Cells.Item(2, 5) = "SAP替代工序"
ObjExcel.Cells.Item(2, 6) = "工作中心"
ObjExcel.Cells.Item(2, 7) = "工序描述"
ObjExcel.Cells.Item(2, 8) = "准备时间"
ObjExcel.Cells.Item(2, 9) = "机器时间"
ObjExcel.Cells.Item(2, 10) = "人工时间"
ObjExcel.Cells.Item(2, 11) = "等待时间"
ObjExcel.Cells.Item(2, 12) = "最小发送量/单位"
ObjExcel.Cells.Item(2, 13) = "分解数"
ObjExcel.Cells.Item(2, 14) = "数据收集人"
ObjExcel.Cells.Item(2, 15) = "外协单位"
ObjExcel.Cells.Item(2, 16) = "备注"
StrSQL = "select distinct * from itemtmp1 where status='itemadd'"
'rstX.Open(StrSQL, cnnPDM, adOpenStatic)
datareader = New BaseDataReader(StrSQL)
If datareader.Read Then
pos2 = datareader.FieldCount + 2
TempValue = "A1:" & Chr(Asc("A") + 11) & CStr(datareader.FieldCount + 2)
ObjExcel.Range(TempValue).NumberFormat = "@"
i = 2
Do While datareader.Read
j = 0
pos = 1
Gongyiluxian = IIf(IsDBNull(datareader.Item("Gongyiluxian").ToString.Trim), "", datareader.Item("Gongyiluxian").ToString.Trim).ToString.Trim
Zhunbeishijian = IIf(IsDBNull(datareader.Item("Zhunbeishijian").ToString.Trim), "", datareader.Item("Zhunbeishijian").ToString.Trim).ToString.Trim
Jiqishijian = IIf(IsDBNull(datareader.Item("Jiqishijian").ToString.Trim), "", datareader.Item("Jiqishijian").ToString.Trim).ToString.Trim
Rengongshijian = IIf(IsDBNull(datareader.Item("Rengongshijian").ToString.Trim), "", datareader.Item("Rengongshijian").ToString.Trim).ToString.Trim
Do While pos > 0 Or Len(Gongyiluxian) > 0
j = j + 1
i = i + 1
If i > pos2 Then
TempValue = "A" & CStr(pos2 + 1) & ":" & Chr(Asc("A") + 11) & CStr(pos2 + 50)
ObjExcel.Range(TempValue).NumberFormat = "@"
pos2 = pos2 + 50
End If
pos = InStr(Gongyiluxian, "/")
ObjExcel.Cells.Item(i, 1) = datareader.Item("PartID").ToString.Trim
ObjExcel.Cells.Item(i, 2) = IIf(IsDBNull(datareader.Item("Wuliaomiaoshu").ToString.Trim), "", datareader.Item("Wuliaomiaoshu").ToString.Trim)
ObjExcel.Cells.Item(i, 3) = CStr(10 * j)
ObjExcel.Cells.Item(i, 4) = ""
ObjExcel.Cells.Item(i, 5) = ""
ObjExcel.Cells.Item(i, 6) = ""
ObjExcel.Cells.Item(i, 11) = ""
ObjExcel.Cells.Item(i, 12) = ""
ObjExcel.Cells.Item(i, 13) = "1"
ObjExcel.Cells.Item(i, 14) = ""
ObjExcel.Cells.Item(i, 15) = ""
ObjExcel.Cells.Item(i, 16) = ""
If pos > 0 Then
ObjExcel.Cells.Item(i, 7) = Microsoft.VisualBasic.Left(Gongyiluxian, CInt(pos - 1)).Trim.ToString
Gongyiluxian = Mid(Gongyiluxian, CInt(pos + 1)).Trim.ToString
Else
ObjExcel.Cells.Item(i, 7) = Gongyiluxian
Gongyiluxian = ""
End If
pos1 = InStr(Zhunbeishijian, "/")
If pos1 > 0 Then
ObjExcel.Cells.Item(i, 8) = Microsoft.VisualBasic.Left(Zhunbeishijian, CInt(pos1 - 1)).Trim.ToString
Zhunbeishijian = Mid(Zhunbeishijian, CInt(pos + 1)).Trim.ToString
Else
ObjExcel.Cells.Item(i, 8) = Zhunbeishijian
Zhunbeishijian = ""
End If
pos1 = InStr(Jiqishijian, "/")
If pos1 > 0 Then
ObjExcel.Cells.Item(i, 9) = Microsoft.VisualBasic.Left(Jiqishijian, CInt(pos1 - 1)).Trim.ToString
Jiqishijian = Mid(Jiqishijian, CInt(pos + 1)).Trim.ToString
Else
ObjExcel.Cells.Item(i, 9) = Jiqishijian
Jiqishijian = ""
End If
pos1 = InStr(Rengongshijian, "/")
If pos1 > 0 Then
ObjExcel.Cells.Item(i, 10) = Microsoft.VisualBasic.Left(Rengongshijian, CInt(pos1 - 1)).Trim.ToString
Rengongshijian = Mid(Rengongshijian, CInt(pos + 1)).Trim.ToString
Else
ObjExcel.Cells.Item(i, 10) = Rengongshijian
Rengongshijian = ""
End If
Loop
i = i + 1
Loop
datareader.Close()
ObjExcel = Nothing
End If
datareader.Close()
ObjExcel.ActiveWorkbook.SaveAs(fileName)
'ExcelSheet.Close()
'ExcelSheet = Nothing
ObjExcel = Nothing
End If
Dim strTemp1() As String
If StrSign = "all" Then
ReDim strTemp1(4)
strTemp1(1) = "bomdel"
strTemp1(2) = "bomnew"
strTemp1(3) = "bomadd"
strTemp1(4) = "bommod"
ElseIf StrSign = "bomdel" Or StrSign = "bomnew" Or StrSign = "bomadd" Or StrSign = "bommod" Then
ReDim strTemp1(1)
strTemp1(1) = StrSign
Else
GoTo exitOk
End If
For pos = 1 To UBound(strTemp1)
fileName = PathName & strTemp1(CInt(pos)) & g_PdmSystem.CurUser & ".xls"
'表头
'objexcel = VBA.CreateObject("excel.application")
'ExcelSheet = VBA.CreateObject("excel.sheet")
'ExcelSheet.Application.Visible = True
ObjExcel.Cells.Item(1, 1) = "PMATNR"
ObjExcel.Cells.Item(1, 2) = "MATNR"
ObjExcel.Cells.Item(1, 3) = "QTY"
ObjExcel.Cells.Item(1, 4) = "MEINS"
StrSQL = "select * from bomtmp1 where status='" & strTemp1(CInt(pos)) & "'"
'rstX.Open(StrSQL, cnnPDM, adOpenStatic)
datareader = New BaseDataReader(StrSQL)
If datareader.Read Then
TempValue = "A1:" & Chr(Asc("A") + 11) & CStr(datareader.FieldCount + 1)
ObjExcel.Range(TempValue).NumberFormat = "@"
i = 1
Do While datareader.Read
i = i + 1
ObjExcel.Cells.Item(i, 1) = datareader.Item("superid").ToString
ObjExcel.Cells.Item(i, 2) = datareader.Item("subid").ToString.Trim
ObjExcel.Cells.Item(i, 3) = datareader.Item("Number").ToString.Trim
ObjExcel.Cells.Item(i, 4) = UCase(datareader.Item("jibendanwei").ToString.Trim)
Loop
Else
datareader.Close()
ObjExcel = Nothing
End If
datareader.Close()
ObjExcel.ScreenUpdating = True
ObjExcel.ActiveWorkbook.SaveAs(fileName)
ObjExcel = Nothing
Next pos
exitOk:
' Me.MousePointer = 0
MsgBox("导出完毕", MsgBoxStyle.Information Or MsgBoxStyle.OkOnly)
Exit Sub
Catch ex As Exception
System.Windows.Forms.Cursor.Current = Cursors.Default
MsgBox("导出失败,原因：" & Err.Description, MsgBoxStyle.Information Or MsgBoxStyle.OkOnly)
'ExcelSheet.Close()
'ExcelSheet = Nothing
ObjExcel = Nothing
End Try
End Sub
''' <summary>
''' 导出图档
''' </summary>
''' <param name="LV"></param>
''' <param name="sign"></param>
''' <remarks></remarks>
Friend Shared Sub OutputDocument(ByVal LV As ListView, ByVal sign As Integer)
Dim i As Integer
Dim DocOid(,) As String
Dim typeID As String
Dim versionNO As String
Dim pathName As String
Dim ModID As String
Dim DocCount As Integer
Dim IsSucc As Boolean
Dim FileName As String
'added by xym 2003-11-21
Dim NumOfSucc As Integer '下载成功的文档数
Dim ColSucc As Collection
Dim NumOfFail As Integer '下载失败的文档数
Dim ColFail As Collection
Dim NumNotRight As Integer '没有权限下载的文档数
Dim ColNotRight As Collection
Dim StreamW As StreamWriter
Dim path As String
DocCount = 0
Try
For i = 0 To LV.Items.Count - 1
If LV.Items.Item(i).Checked = True Then
DocCount = DocCount + 1
End If
Next i
If DocCount = 0 Then
MsgBox("请选择需要导出的数据", MsgBoxStyle.Information)
Exit Sub
End If
NumOfSucc = 0 '初始化 added by xym 2003-11-22
NumOfFail = 0
NumNotRight = 0
If sign <> 1 Then
System.Windows.Forms.Cursor.Current = Cursors.WaitCursor
For i = 0 To LV.Items.Count - 1
If LV.Items.Item(i).Checked = True Then
ReDim Preserve DocOid(3, UBound(DocOid) + 1)
With LV
typeID = Split(Trim(LV.Items.Item(i).Name), "__")(1)
ModID = Split(Trim(LV.Items.Item(i).Name), "__")(2)
versionNO = Split(Trim(LV.Items.Item(i).Name), "__")(3)
End With
'wyy 2007-1-12 无论什么类型的图档都可以下载，如果不支持签名，则只下载图档。
' Sys.getDocIDSouFile TypeID, ModID, VersionNO, strSourceName, StrExist
'If InStr(1, LCase(StrExist), "gwd") > 0 Or InStr(1, LCase(StrExist), "dwg") > 0 Or InStr(1, LCase(StrExist), "xls") > 0 Or InStr(1, LCase(StrExist), "doc") Or InStr(1, LCase(StrExist), "gxk") Or InStr(1, LCase(StrExist), "kmg") Then
DocOid(1, i + 1) = ModID
DocOid(2, i + 1) = versionNO
DocOid(3, i + 1) = typeID
End If
Next i
'wyy 2007-1-11 统一调用签字方法
If sign = 2 Then
FileSignature.PrintDocSign(DocOid, 1)
ElseIf sign = 3 Then
FileSignature.PrintDocSign(DocOid, 2)
ElseIf sign = 4 Then
FileSignature.PrintDocSign(DocOid, 3)
End If
Exit Sub
Else
path = UilCommFunc.GetDownLoadDir(0, "请选择文件路径")
If path = "" Then
Exit Sub
End If
'写关于图纸下载情况的文本信息
If path.EndsWith("\") = False Then
path = path & "\"
End If
PathName = Trim(path) & "信息.txt"
If File.Exists(PathName) = False Then
File.Delete(PathName)
End If
StreamW = File.CreateText(PathName)
ColSucc = New Collection
ColFail = New Collection
ColNotRight = New Collection
'打开文件记录信息
StreamW.WriteLine("-----------------图档下载情况-------------------------------")
For i = 0 To LV.Items.Count - 1
If LV.Items.Item(i).Checked = True Then
With LV
typeID = Split(LV.Items.Item(i).Name.Trim.ToString, "__")(1)
ModID = Split(LV.Items.Item(i).Name.ToString.Trim, "__")(2)
versionNO = Split(LV.Items.Item(i).Name.Trim.ToString, "__")(3)
End With
'判断下载图档的权限 added by xym 2003-11-21
If Not g_RightClass.IfHasObjRight(TypeID, ModID, objAccessEnum.objdownload, VersionNO) Then 'added by xym 2004-7-15 增加对象的版本
'记录没有权限下载的图档 added by xym 2003-11-21
ColNotRight.Add("[" & Trim(ModID) & "," & VersionNO & "] 没有权限下载")
NumNotRight = NumNotRight + 1
GoTo tiNex
End If
' Sys.getDocIDSouFile TypeID, ModID, VersionNO, strSourceName, StrExist 'wyy 2007-1-12 注释
'wtd 2007-1-11 表单“不签名”时导出图档的处理。
g_DocType = New DocType
g_DocType.InitDoctype()
If (g_DocType.GetTypeAttr(TypeID) And 64) = 64 Then
IsSucc = DocCommFunc.FormFileDownLoadFromDB(ModID, versionNO, typeID, path, FileName)
Else
FileName = DocCommFunc.DownAllFileToLocal(ModID, versionNO, False, False, "", path, False, False, typeID)
End If
If FileName <> "" Or IsSucc = True Then
'下载成功的图档 added by xym 2003-11-21
ColSucc.Add("图档代号为：[" & Trim(ModID) & "], 版本为：" & versionNO & "")
NumOfSucc = NumOfSucc + 1
Else
'下载失败的图档 added by xym 2003-11-21
ColFail.Add("图档代号为：[" & Trim(ModID) & "], 版本为：" & versionNO & "")
NumOfFail = NumOfFail + 1
End If
End If
tiNex: Next i
MsgBox("下载完毕!", MsgBoxStyle.Information Or MsgBoxStyle.OkOnly)
End If
StreamW.WriteLine("下载成功的图档：[" & NumOfSucc & "]个")
For i = 1 To ColSucc.Count
StreamW.WriteLine(ColSucc.Item(i))
Next i
StreamW.WriteLine("---------------------")
StreamW.WriteLine("")
StreamW.WriteLine("下载失败的图档：[" & NumOfFail & "]个")
For i = 1 To ColFail.Count
StreamW.WriteLine(ColFail.Item(i).ToString.Trim)
Next i
StreamW.WriteLine("---------------------")
StreamW.WriteLine("")
StreamW.WriteLine("无权限下载的图档：[" & NumNotRight & "]个")
For i = 1 To ColNotRight.Count
StreamW.WriteLine(ColNotRight.Item(i).ToString)
Next i
StreamW.WriteLine("")
StreamW.WriteLine("---------------------图档下载完成---------------------------")
StreamW.Close()
System.Diagnostics.Process.Start(PathName)
StreamW = Nothing
ColSucc = Nothing
ColFail = Nothing
ColNotRight = Nothing
Catch ex As Exception
If StreamW IsNot Nothing Then
StreamW.Close()
StreamW = Nothing
End If
ColSucc = Nothing
ColFail = Nothing
ColNotRight = Nothing
End Try
End Sub
''' <summary>
''' 导出文本文件到ERP
''' </summary>
''' <param name="fileName"></param>
''' <param name="CmbSAP"></param>
''' <remarks></remarks>
Friend Shared Sub OutputTxtSAP(ByVal fileName As String, Optional ByVal CmbSAP As String = "")
'rzy2005-11-30为四机加：SAP集成：导出SAP所需的TXT文件
Dim dataReader As BaseDataReader
Dim DirName As String
Dim PathName As String
Dim StrSQL As String
Dim Gongyiluxian As String
Dim Zhunbeishijian As String
Dim Jiqishijian As String
Dim Rengongshijian As String
Dim i As Long
Dim j As Long
Dim pos As Long
Dim pos1 As Long
Dim pos2 As Long
Dim StrSign As String
Dim str As String
Dim StreamW As StreamWriter
If CmbSAP.Trim = "" Then
MsgBox("请选择导出类型.", MsgBoxStyle.Information Or MsgBoxStyle.OkOnly)
Exit Sub
End If
Try
DirName = fileName
PathName = DirName.Trim.ToString & "\" & Format(Now, "yyMMddHHmm")
StrSign = LCase(CmbSAP.Trim)
If StrSign = "all" Or StrSign = "item" Then
fileName = PathName & "item" & g_PdmSystem.CurUser & ".txt"
If File.Exists(fileName) = False Then
File.Create(fileName)
End If
StreamW = New StreamWriter(fileName, True)
'表头:各字段之间要加Tab键（chr(9)）
str = ""
str = "MATNR" & Chr(9) & "MTART" & Chr(9) & "MEINS" & Chr(9) & "MAKTX" & Chr(9) & _
"MERKS" & Chr(9) & "DISMM" & Chr(9) & "BESKZ" & Chr(9) & "DISPO" & Chr(9) & _
"FHORI" & Chr(9) & "DISLS" & Chr(9) & "MTVFP"
StreamW.WriteLine(str)
StrSQL = "select distinct * from itemtmp1 where status='itemadd'"
datareader = New BaseDataReader(StrSQL)
If datareader.Read Then
While datareader.Read
str = ""
str = datareader.Item("PartID").ToString.Trim & Chr(9)
If IsDBNull(datareader.Item("Wuliaoleixing").ToString.Trim) Then
str = str & "" & "," & Chr(9)
Else
str = str & ChangePartType(datareader.Item("Wuliaoleixing").ToString.Trim) & Chr(9)
End If
str = str & UCase(datareader.Item("jibendanwei").ToString.Trim) & Chr(9)
str = str & IIf(IsDBNull(datareader.Item("Wuliaomiaoshu").ToString.Trim), "", datareader.Item("Wuliaomiaoshu").ToString.Trim).ToString.Trim & Chr(9)
str = str & "1000" & Chr(9)
str = str & "PD" & Chr(9)
str = str & "E" & Chr(9)
str = str & "000" & Chr(9)
str = str & "000" & Chr(9)
str = str & "EX" & Chr(9)
str = str & "1"
StreamW.WriteLine(str)
End While
Else
datareader.Close()
Exit Sub
End If
datareader.Close()
StreamW.Close()
End If
If StrSign = "all" Or StrSign = "technics" Then
'工艺路线
fileName = PathName & "technology" & g_PdmSystem.CurUser & ".txt"
If File.Exists(fileName) = False Then
File.Create(fileName)
End If
StreamW = New StreamWriter(fileName, True)
'表头
str = ""
str = "生产物料工艺主数据收集表"
StreamW.WriteLine(str)
str = ""
str = "图号" & Chr(9) & "名称" & Chr(9) & "SAP工序" & Chr(9) & "替代" & Chr(9) & _
"SAP替代工序" & Chr(9) & "工作中心" & Chr(9) & "工序描述" & Chr(9) & "准备时间" & Chr(9) & _
"机器时间" & Chr(9) & "人工时间" & Chr(9) & "等待时间" & Chr(9) & _
"最小发送量/单位" & Chr(9) & "分解数" & Chr(9) & "数据收集人" & Chr(9) & _
"外协单位" & Chr(9) & "备注"
StreamW.WriteLine(str)
StrSQL = "select distinct * from itemtmp1 where status='itemadd'"
datareader = New BaseDataReader(StrSQL)
If datareader.Read Then
pos2 = datareader.FieldCount + 2
i = 2
Do While datareader.Read
str = ""
j = 0
pos = 1
Gongyiluxian = IIf(IsDBNull(datareader.Item("Gongyiluxian").ToString.Trim), "", datareader.Item("Gongyiluxian").ToString.Trim).ToString.Trim
Zhunbeishijian = IIf(IsDBNull(datareader.Item("Zhunbeishijian").ToString.Trim), "", datareader.Item("Zhunbeishijian").ToString.Trim).ToString.Trim
Jiqishijian = IIf(IsDBNull(datareader.Item("Jiqishijian").ToString.Trim), "", datareader.Item("Jiqishijian").ToString.Trim).ToString.Trim
Rengongshijian = IIf(IsDBNull(datareader.Item("Rengongshijian").ToString.Trim), "", datareader.Item("Rengongshijian").ToString.Trim).ToString.Trim
Do While pos > 0 Or Len(Gongyiluxian) > 0
j = j + 1
i = i + 1
If i > pos2 Then
pos2 = pos2 + 50
End If
pos = InStr(Gongyiluxian, "/")
str = str & datareader.Item("PartID").ToString.Trim & Chr(9)
str = str & IIf(IsDBNull(datareader.Item("Wuliaomiaoshu").ToString.Trim), "", datareader.Item("Wuliaomiaoshu").ToString.Trim).ToString.Trim & Chr(9)
str = str & CStr(10 * j) & Chr(9)
str = str & "" & Chr(9)
str = str & "" & Chr(9)
str = str & "" & Chr(9)
If pos > 0 Then
str = str & Microsoft.VisualBasic.Left(Gongyiluxian, CInt(pos - 1)).Trim.ToString & Chr(9)
Gongyiluxian = Mid(Gongyiluxian, CInt(pos + 1)).Trim.ToString
Else
str = str & Gongyiluxian & Chr(9)
Gongyiluxian = ""
End If
pos1 = InStr(Zhunbeishijian, "/")
If pos1 > 0 Then
str = str & Microsoft.VisualBasic.Left(Zhunbeishijian, CInt(pos1 - 1)).Trim.ToString & Chr(9)
Zhunbeishijian = Mid(Zhunbeishijian, CInt(pos1 + 1)).Trim.ToString
Else
str = str & Zhunbeishijian & Chr(9)
Zhunbeishijian = ""
End If
pos1 = InStr(Jiqishijian, "/")
If pos1 > 0 Then
str = str & Microsoft.VisualBasic.Left(Jiqishijian, CInt(pos1 - 1)).Trim.ToString & Chr(9)
Jiqishijian = Mid(Jiqishijian, CInt(pos1 + 1)).Trim.ToString
Else
str = str & Jiqishijian & Chr(9)
Jiqishijian = ""
End If
pos1 = InStr(Rengongshijian, "/")
If pos1 > 0 Then
str = str & Microsoft.VisualBasic.Left(Rengongshijian, CInt(pos1 - 1)).Trim.ToString & Chr(9)
Rengongshijian = Mid(Rengongshijian, CInt(pos1 + 1)).Trim.ToString
Else
str = str & Rengongshijian & Chr(9)
Rengongshijian = ""
End If
str = str & "" & Chr(9)
str = str & "" & Chr(9)
str = str & "1" & Chr(9)
str = str & "" & Chr(9)
str = str & "" & Chr(9)
str = str & "" '最后一行
Loop
StreamW.WriteLine(str)
i = i + 1
Loop
Else
datareader.Close()
Exit Sub
End If
datareader.Close()
StreamW.Close()
End If
Dim strTemp1() As String
If StrSign = "all" Then
ReDim strTemp1(4)
strTemp1(1) = "bomdel"
strTemp1(2) = "bomnew"
strTemp1(3) = "bomadd"
strTemp1(4) = "bommod"
ElseIf StrSign = "bomdel" Or StrSign = "bomnew" Or StrSign = "bomadd" Or StrSign = "bommod" Then
ReDim strTemp1(1)
strTemp1(1) = StrSign
Else
GoTo exitOk
End If
For pos = 1 To UBound(strTemp1)
fileName = PathName & strTemp1(CInt(pos)) & g_PdmSystem.CurUser & ".txt"
If File.Exists(fileName) = False Then
File.Create(fileName)
End If
StreamW = New StreamWriter(fileName, True)
'表头
str = ""
str = "PMATNR" & Chr(9)
str = str & "MATNR" & Chr(9)
str = str & "QTY" & Chr(9)
str = str & "MEINS"
StreamW.WriteLine(str)
StrSQL = "select * from bomtmp1 where status='" & strTemp1(CInt(pos)) & "'"
datareader = New BaseDataReader(StrSQL)
i = 1
If datareader.Read Then
Do While datareader.Read
str = ""
i = i + 1
str = datareader.Item("superid").ToString.Trim & Chr(9)
str = str & datareader.Item("subid").ToString.Trim & Chr(9)
'处理小数点的情况
If InStr(1, datareader.Item("Number").ToString.Trim, ".") > 0 Then
If InStr(1, datareader.Item("Number").ToString.Trim, ".") = 1 Then
str = str & "0" & datareader.Item("Number").ToString.Trim & Chr(9)
Else
str = str & datareader.Item("Number").ToString.Trim & Chr(9)
End If
Else
str = str & datareader.Item("Number").ToString.Trim & Chr(9)
End If
If strTemp1(CInt(pos)) = "bomdel" Then 'bomdel时，单位置为空
str = str & "" & Chr(9)
Else
str = str & UCase(datareader.Item("jibendanwei").ToString.Trim) & Chr(9)
End If
StreamW.WriteLine(str)
Loop
Else
datareader.Close()
StreamW.Close()
StreamW = Nothing
Exit For
End If
datareader.Close()
StreamW.Close()
StreamW = Nothing
Next pos
exitOk:
MsgBox("导出完毕。", MsgBoxStyle.Information Or MsgBoxStyle.OkOnly)
Exit Sub
Catch ex As Exception
MsgBox("导出失败。原因：" & Err.Description, MsgBoxStyle.Information Or MsgBoxStyle.OkOnly)
If StreamW IsNot Nothing Then
StreamW.Close()
StreamW = Nothing
End If
End Try
End Sub
''' <summary>
''' 导出图样目录
''' </summary>
''' <param name="Lvw">列表</param>
''' <param name="FileDialog">对话框</param>
''' <param name="StrID">对象代号</param>
''' <param name="statusid">状态号</param>
''' <param name="ColReportFields">属性集合</param>
''' <param name="PrdOrPart">产品或零件</param>
''' <param name="ReportID">报表代号</param>
''' <param name="prdInnerCode">产品内码</param>
''' <remarks></remarks>
Friend Shared Sub OutputDocToExcel(ByVal Lvw As ListView, ByVal FileDialog As OpenFileDialog, ByVal StrID As String, ByVal statusid As String, ByVal ColReportFields As Collection, ByVal PrdOrPart As String, ByVal ReportID As String, ByVal prdInnerCode As String)
Dim objExcel As Excel.Application
Dim objBook As Excel.Workbook
Dim rng As Excel.Range
Dim product As New PDMProduct
Dim intBrow As Integer
Dim intErow As Integer
Dim intBeginX As Integer
Dim intBeginY As Integer
Dim intDBeginX As Integer
Dim intDBeginY As Integer
Dim intDataRow As Integer
Dim intItemCount As Integer '汇总纪录总数
Dim intPage As Integer '输出页计数器
Dim intPCount As Integer '输出总页数
Dim intItemIndex As Integer
Dim i As Integer
Dim j As Integer
Dim actDataCol(20) As Integer
Dim intX As Integer '表头的个数
Dim intY As Integer '计数器
Dim intZ As Integer '计数器
Dim partVer As Integer
Dim intRow As Integer
Dim intI As Integer
Dim intTRows As Long
Dim intTCols As Integer
Dim partID As String
Dim strfName As String = "" '有扩展名的模板文件名
Dim categoryName As String = ""
Dim categoryID As String = ""
Dim productId As String = "" '' add by gwj 2002/04/04
Dim totalEnd As String = "" '模板结束位置
Dim dataBegin As String = "" '数据区开始位置
Dim dataEnd As String = "" '数据区结束位置
Dim tittle As String = "" '表开始位置
Dim titleend As String = "" '表结束位置
Dim time As String = ""
Dim add As String = ""
Dim signCell As String = ""
Dim tempValue As String = ""
'Dim StateIndex As Integer 'wyy 2005-1-5，记录零件属性所在数据集的位置
'Dim IsNext As Boolean 'wyy 2005-1-5，记录是否excel转向下一行
Dim dotFileName As String = "" '报表模版名称
Dim partName As String = ""
Dim isProtect As Boolean 'wyy 2006-5-8 增加变量
Dim collPrdAttr As Collection = Nothing 'wyy 2006-3-30 增加产品属性集合
'wyy 2006-8-4 用于判断定位文字是否找到
Dim itemExcelCount As Long 'rzy2007-1-13在博实加：记录输出到Excel中的记录数
Dim isExist As Boolean '判断零件是否存在
Dim prdIDandCode(,) As String '获取产品内码或代号
Dim clsProps As New Collection
Dim person As New Person
On Error Resume Next
'在报表的表头中输出零件内容信息
If PrdOrPart <> "prt" And PrdOrPart <> "prd" And PrdOrPart <> "doc" Then 'wyy 2007-1-8 处理图档列表
Exit Sub
End If
If Lvw.Items.Count = 0 Then
Exit Sub
End If
dotFileName = ReportParameter.ReportBrl.GetReportDotFileName(ReportID)
intTRows = 0
For i = 0 To Lvw.Items.Count - 1
If Lvw.Items(i).Checked = True Then
intTRows = intTRows + 1
End If
Next i
If Trim(dotFileName) = "" Then
With FileDialog
.Filter = "Excel文件 (*.xls)|*.xls"
.Title = "选择报表模板"
End With
If FileDialog.ShowDialog = DialogResult.OK Then
strfName = FileDialog.FileName.Trim
End If
Else
If BRL.FileService.FileLoadFromDB.File_DownLoadFromDB(dotFileName, strfName, g_PdmSystem.WorkFolder) = False Then
MsgBox("下载报表模版失败。错误原因：" & strfName, MsgBoxStyle.Information Or MsgBoxStyle.OkOnly)
Exit Sub
End If
End If
ObjExcel = New Excel.Application
ObjExcel.Cursor = CType(XlMousePointer.xlWait, Excel.XlMousePointer)
ObjBook = ObjExcel.Workbooks.Open(strfName)
ObjExcel.Visible = True
ObjExcel.ActiveWorkbook.SaveAs(g_PdmSystem.WorkFolder & "\" + ReportID + "_" + CStr(Format(Now, "yyyy-MM-dd")) + ".xls")
File.Delete(strfName)
'查找标志，计算位置坐标
totalEnd = ObjExcel.Cells.Find("<aeof*>", , XlFindLookIn.xlFormulas, XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
dataBegin = ObjExcel.Cells.Find("<dbof*>", , XlFindLookIn.xlFormulas, XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
dataEnd = ObjExcel.Cells.Find("<deof*>", , XlFindLookIn.xlFormulas, XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
tittle = ObjExcel.Cells.Find("<tbof*>", , XlFindLookIn.xlFormulas, XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
titleend = ObjExcel.Cells.Find("<teof*>", , XlFindLookIn.xlFormulas, XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
Rng = ObjExcel.Range(tittle, totalEnd)
If ObjBook.ProtectWindows = True Then
ObjBook.Unprotect() 'wyy 2006-3-30 如果碰到报表模版有锁定列的情况，需要先撤消保护
isProtect = True
End If
'wyy 2006-8-4 写入之前，判断定位文字是否存在
If ReportParameter.IsProduct = True Then 'wyy 2006-5-10 修改与明细导出一致
product = New PDMProduct
If ReportParameter.IsProduct = True Then
product = New PDMProduct
If product.GetPrdId(prdIDandCode) Then
For a As Integer = 1 To UBound(prdIDandCode, 2)
If prdIDandCode(2, a).ToString = prdInnerCode Then
productId = prdIDandCode(1, a).ToString
product.GetCategory(productId, categoryID, categoryName)
collPrdAttr = ReportParameter.GetAttribute(categoryID, productId)
Exit For
End If
Next
End If
End If
'wyy 2006-3-30 输出产品自定义属性
For i = 1 To collPrdAttr.Count
signCell = ObjExcel.Cells.Find("<" & CType(collPrdAttr.Item(i), Collection)(1).ToString.Trim & "*>", , XlFindLookIn.xlFormulas, _
XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
If signCell <> "" Then
CType(Rng.Cells(CInt(FindRowNO(signCell)), CInt(FindColNO(signCell))), Excel.Range).Activate()
ObjExcel.ActiveCell.Replace("<" & CType(collPrdAttr.Item(i), Collection)(1).ToString.Trim & "*>", CType(collPrdAttr.Item(i), Collection)(5).ToString.Trim, XlLookAt.xlPart, _
XlSearchOrder.xlByRows, False)
End If
signCell = ""
Next
Else
productId = ""
End If
If tittle <> "" Or titleend <> "" Then
ObjExcel.Cells.Item(tittle) = ""
ObjExcel.Cells.Item(titleend) = ""
End If
ObjExcel.Cells.Replace("<dbof*>", "", XlLookAt.xlPart, XlSearchOrder.xlByRows, False)
ObjExcel.Cells.Replace("<deof*>", "", XlLookAt.xlPart, XlSearchOrder.xlByRows, False)
ObjExcel.Cells.Replace("<aeof*>", "", XlLookAt.xlPart, XlSearchOrder.xlByRows, False)
intBrow = CInt(FindRowNO(dataBegin)) '数据开始行数
intErow = CInt(FindRowNO(dataEnd)) '数据结束行数
intDataRow = intErow - intBrow + 1 '每页数据行数
intErow = CInt(FindRowNO(totalEnd)) '每页行数
If tittle <> "" Or titleend <> "" Then
intBeginX = CInt(FindRowNO(tittle)) 'Title开始行
intBeginY = CInt(FindColNO(tittle)) 'Title开始列
End If
intDBeginX = CInt(FindRowNO(dataBegin)) '数据开始行
intDBeginY = CInt(FindColNO(dataBegin)) '数据开始列
intItemCount = CInt(intTRows)
intItemIndex = 1
If intItemCount Mod intDataRow = 0 Then '计算总页数
intPCount = CInt(Int(intItemCount / intDataRow))
Else
intPCount = CInt(Fix(intItemCount / intDataRow) + 1)
End If
intX = intTCols
i = 1
intX = Lvw.Columns.Count '初始化表头
If tittle <> "" And titleend <> "" Then
Rng = ObjExcel.Range(tittle)
ActDataCol(i) = Rng.Column
intRow = Rng.Row
Rng = CType(CType("", Range), Excel.Range)
While Rng.Column < ObjExcel.Range(titleend).Column
Rng.Activate()
If CBool(Rng.MergeCells) Then
j = ObjExcel.ActiveCell.MergeArea.Cells.Count
Else
j = ObjExcel.ActiveCell.Column + 1
End If
i = i + 1
ActDataCol(i) = CType(Rng.MergeArea.Cells(j), Excel.Range).Column + 1
Rng = CType(CType(ObjExcel.Cells(intRow, ActDataCol(i)), Range), Excel.Range)
End While
For intY = 1 To intX
j = ActDataCol(intY)
Rng.Cells(intBeginX, j) = Trim(Lvw.Columns.Item(intY).Text)
Next intY
End If
If PrdOrPart = "prt" Then
partID = StrID
partName = PartCommFunc.GetPartName(partID)
partVer = CInt(PartCommFunc.GetPartVer(partID, IsExist))
End If
'If jiutuhao = 1 Then 'rzy2007-1-12在博实加：增加零件旧图号的输出
' Dim jthString As String
' jthString = ReportParameter.GetPropValues("partrevision", partID, "@@" & strNameJTH)
' jthString = Mid(jthString, 3)
' signCell = rng.Cells.Find("<part" & strJTH & "*>", , XlFindLookIn.xlFormulas, _
' XlLookAt.xlPart, XlSearchOrder.xlByRows, XlSearchDirection.xlNext, False).Address
' If signCell <> "" Then
' rng.Cells(CInt(FindRowNO(signCell)), CInt(FindColNO(signCell))).Activate()
' rng.ActiveCell.Replace("<part" & strJTH & "*>", jthString, XlLookAt.xlPart, _
' XlSearchOrder.xlByRows, False)
' End If
' signCell = ""
'End If
'填写表头表尾信息 编号 wyy 2003-8-13, id, name，改为PartID, partname,取报表列表框中第一行的内容
signCell = objExcel.Cells.Find("<PartID*>", , XlFindLookIn.xlFormulas, _
XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
If signCell <> "" Then
objExcel.Cells.Range(signCell).Activate()
objExcel.ActiveCell.Replace("<PartID*>", Trim(partID), XlLookAt.xlPart, _
XlSearchOrder.xlByRows, False)
End If
signCell = ""
'名称
signCell = objExcel.Cells.Find("<partname*>", , XlFindLookIn.xlFormulas, _
XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
If signCell <> "" Then
objExcel.Cells.Range(signCell).Activate()
objExcel.ActiveCell.Replace("<partname*>", Trim(partName), XlLookAt.xlPart, _
XlSearchOrder.xlByRows, False)
End If
signCell = ""
'wyy 2006-8-18 增加部件版本输出
signCell = objExcel.Cells.Find("<partver*>", , XlFindLookIn.xlFormulas, _
XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
If signCell <> "" Then
CType(objExcel.Sheets("Sheet1"), Worksheet).Cells.Range(signCell).Activate()
objExcel.ActiveCell.Replace("<partver*>", partVer, XlLookAt.xlPart, _
XlSearchOrder.xlByRows, False)
End If
signCell = ""
'wyy 2006-5-8 增加产品配置状态号输出
signCell = objExcel.Cells.Find("<statusid*>", , XlFindLookIn.xlFormulas, XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
If signCell <> "" Then
objExcel.Cells.Range(signCell).Activate()
objExcel.ActiveCell.Replace("<statusid*>", statusid, XlLookAt.xlPart, _
XlSearchOrder.xlByRows, False)
End If
signCell = ""
'填表人
signCell = objExcel.Cells.Find("<designer*>", , XlFindLookIn.xlFormulas, XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
If signCell <> "" Then
objExcel.Cells.Range(signCell).Activate()
person.LoadAllIdAndName()
objExcel.Cells.Replace("<designer*>", IIf(person.GetPsnName(g_PdmSystem.CurUser) = "", g_PdmSystem.CurUser, person.GetPsnName(g_PdmSystem.CurUser)), XlLookAt.xlPart, XlSearchOrder.xlByRows, False)
End If
signCell = ""
'时间
time = CDate(datNow()).Date.ToString 'wyy 2003-7-23, datNow取服务器时间
signCell = objExcel.Cells.Find("<now*>", , XlFindLookIn.xlFormulas, XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
If signCell <> "" Then
objExcel.Cells.Range(signCell).Activate()
objExcel.Cells.Replace("<now*>", time, XlLookAt.xlPart, XlSearchOrder.xlByRows, False)
objExcel.ActiveCell.AutoFit()
End If
signCell = ""
time = ""
clsProps = ReportParameter.GetAttribute("partrevision", partID, partVer)
For i = 1 To clsProps.Count
If CType(clsProps.Item(i), Collection).Item(1).ToString = "effecttime" Then
time = CType(clsProps.Item(i), Collection)(5).ToString.Trim
If time = "" Then
time = Left(CDate(datNow()).Date.ToString, 10)
Else
time = Left(CDate(time).Date.ToString, 10)
End If
signCell = objExcel.Cells.Find("<efftime*>", , XlFindLookIn.xlFormulas, XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
If signCell <> "" Then
objExcel.Cells.Range(signCell).Activate()
objExcel.Cells.Replace("<efftime*>", time, XlLookAt.xlPart, XlSearchOrder.xlByRows, False)
objExcel.ActiveCell.ShrinkToFit = True
End If
signCell = ""
Exit For
End If
Next
If intPCount > 1 Then
objExcel.Range("A1:" + totalEnd).Copy()
End If
Dim CurPages As Integer '当前总页数
Dim RemainPages As Integer '剩余总页数=总页数-当前总页数
CurPages = 1
For intPage = 1 To intPCount
If CurPages * 2 < intPCount Then
objExcel.Cells.Range("1:" + CStr(intErow * CurPages)).Select()
CType(objExcel.Selection, Excel.Range).Copy()
CType(objExcel.ActiveSheet, Worksheet).HPageBreaks.Add(objExcel.Range("A" + CStr(CurPages * intErow)))
CType(objExcel.Rows(CStr(CurPages * intErow + 1)), Excel.Range).Select()
CType(objExcel.ActiveSheet, Worksheet).Paste()
CurPages = CInt(2 ^ intPage)
Else
RemainPages = intPCount - CurPages
If RemainPages = 0 Then
Exit For
End If
objExcel.Range("1:" + CStr(intErow * RemainPages)).Select()
CType(objExcel.Selection, Excel.Range).Copy()
CType(objExcel.ActiveSheet, Worksheet).HPageBreaks.Add(objExcel.Range("A" + CStr(CurPages * intErow)))
CType(objExcel.Rows(CStr(CurPages * intErow + 1)), Excel.Range).Select()
CType(objExcel.ActiveSheet, Worksheet).Paste()
Exit For
End If
Next
CType(objExcel.Worksheets(1), Excel.Worksheet).PageSetup.PrintArea = ""
CType(objExcel.Rows.Item(intPage * intErow), Excel.Range).PageBreak = XlPageBreak.xlPageBreakManual
itemExcelCount = 0 'rzy2007-1-13在博实修改
intI = 1
Dim ColCheckedLine As Collection 'rzy2007-2-27加：记录LVW中选定行的行号到集合中
ColCheckedLine = New Collection
For i = 0 To Lvw.Items.Count - 1
If Lvw.Items(i).Checked Then
ColCheckedLine.Add(i)
End If
Next i
For intPage = 1 To intPCount
add = ""
If (intPage * intErow) > 99000 Then Exit For
add = objExcel.Cells.Find("<page*>", objExcel.Range("A" + CStr(IIf(intPage = 1, 1, (intPage - 1) * intErow))), XlFindLookIn.xlFormulas, XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address
If add <> "" Then
CType(objExcel.Sheets("sheet1"), Worksheet).Range("A" & CStr(IIf(intPage = 1, 1, (intPage - 1) * intErow)), add).Replace("<page*>", "第" + CStr(intPage) + "页 " + "共" + CStr(intPCount) + "页", XlLookAt.xlPart, XlSearchOrder.xlByRows, False)
CType(objExcel.Sheets("sheet1"), Worksheet).Range(add).Select()
End If
objExcel.Range(add).Activate()
objExcel.ActiveCell.ShrinkToFit = True
'rzy2007-1-12在博实注释掉
' For intY = 1 To CInt(FindRowNO(DataEnd)) - intBrow + 1
' objexcel.Sheets("sheet1").Cells(intDBeginX + (intPage - 1) * intErow + intY - 1, intDBeginY - 1) = intI
' intI = intI + 1
' Next intY
intItemIndex = 1 'rzy2007-1-13在博实加：每一页开始时都应将intItemIndex的值设为1
For intY = 1 To intDataRow '向Excel中填写数据wtd 2006-12-27 修改了判断的导出过程
itemExcelCount = itemExcelCount + 1 'rzy2007-1-13在博实加
If itemExcelCount > intItemCount Then
Exit For
End If
'rzy2007-2-27修改
tempValue = GetLVData(CInt(ColCheckedLine.Item(itemExcelCount)), Lvw)
'rzy2007-1-12在博实加
If Trim(tempValue) <> "" Then
objExcel.Cells(intDBeginX + (intPage - 1) * intErow + intItemIndex - 1, intDBeginY - 1) = intI
intI = intI + 1
End If
',,,,,,,,,,,,,,,,rzy
For intZ = 0 To intX - 1
j = intZ
'rzy2007-1-12在博实修改：原因两页以上的图样目录导出有误，行的位置计算错误
objExcel.Cells(intDBeginX + (intPage - 1) * intErow + intItemIndex - 1, intDBeginY + j) = IIf(Split(tempValue, "@@")(intZ) Is Nothing, "", Split(tempValue, "@@")(intZ)).ToString.Trim
' objexcel.Sheets("sheet1").Cells(intDBeginX + (intPage - 1) * intErow + intItemIndex - 1, intDBeginY + j - 1) = Trim$(IIf(IsNull(Split(TempValue, "@@")(intZ - 1)), "", Split(TempValue, "@@")(intZ - 1)))
Next intZ
'rzy2007-1-13在博实修改
' intItemIndex = intItemIndex + 1
' If intItemIndex > intItemCount Then
' Exit For
' End If
intItemIndex = intItemIndex + 1
' End If 'rzy2007-2-27注释掉
Next intY
Next intPage
signCell = objExcel.Cells.Find("<*>", , XlFindLookIn.xlFormulas, _
XlLookAt.xlPart, XlSearchOrder.xlByRows, CType(XlSearchDirection.xlNext, Excel.XlSearchDirection), False).Address '清空所有标志字符 like <*>
If signCell <> "" Then
objExcel.Cells.Replace("<*>", "", XlLookAt.xlPart, _
XlSearchOrder.xlByRows, False)
End If
signCell = ""
If isProtect = True Then
objBook.Protect(True, True, True) 'wyy 2006-5-8 如果碰到报表模版有锁定列的情况，报表导出结束后，再加上保护
End If
objExcel.Cursor = Excel.XlMousePointer.xlDefault
MsgBox(" 导出完毕。", MsgBoxStyle.Information Or MsgBoxStyle.OkOnly)
End Sub
''' <summary>
''' 取列表每一行的数据
''' </summary>
''' <param name="iLine">行号</param>
''' <param name="ListV">列表</param>
''' <returns></returns>
''' <remarks></remarks>
Friend Shared Function GetLVData(ByVal iLine As Integer, ByVal ListV As ListView) As String '从lvdata中得到指定行i的记录
Dim i As Integer
Dim tempValue As String = ""
Try
tempValue = ListV.Items.Item(iLine).Text
For i = 1 To ListV.Columns.Count - 1
tempValue = tempValue & "@@" & ListV.Items.Item(iLine).SubItems(i).Text.Trim
Next i
GetLVData = tempValue
Catch ex As Exception
GetLVData = tempValue
Exit Function
End Try
End Function
End Class
End Namespace
