'************************************************文件读取********************************************************************
Public Sub xlsread()
Dim lRet As Long
Form2.CD1.Filter = "Excel 文件 (*.xls)|*.xls|Excel 文件 (*.xlsx)|*.xlsx|csv文件 (*.csv)|*.csv"
Form2.CD1.InitDir = App.Path
Form2.CD1.FilterIndex = 1
Form2.CD1.ShowOpen
If (Form2.CD1.FileName <> "") And Form2.CD1.FileName <> "Canceled" Then
Dim xlsapp As Object
Dim xlsworkbook As Object
Dim xlssheet As Object
Set xlsapp = CreateObject("Excel.Application")
xlsapp.DisplayAlerts = False
Set xlsworkbook = xlsapp.Workbooks.Open(Form2.CD1.FileName, False, True)
For Each xlssheet In xlsworkbook.Worksheets
Form2.Combo1.AddItem xlssheet.Name
Next
xlsapp.Quit
Set xlsapp = Nothing
End If
End Sub
'**************************************文件保存**********************************************************************
Public Sub xlssave(msflex As Object)
On Error GoTo ErrHandle
Dim lRet As Long
Form2.CD1.Flags = cdlOFNOverwritePrompt
Form2.CD1.Filter = "Excel 文件(*.xls)|*.xls|Excel 文件(*.xlsx)|*.xlsx|csv文件(*.csv)|*.csv"
Form2.CD1.InitDir = App.Path
Form2.CD1.FileName = ""
Form2.CD1.ShowSave
If (Form2.CD1.FileName <> "") And Form2.CD1.FileName <> "Canceled" Then
Dim xlsapp As Object
Dim xlsworkbook As Object
Dim xlssheet As Object
Set xlsapp = CreateObject("Excel.Application")
Set xlsworkbook = xlsapp.Workbooks.Add
Set xlssheet = xlsworkbook.Worksheets(1)
Dim lngRowsCount As Long, lngColumnsCount As Long, lngRow As Long, lngColumn As Long
Dim strtext As String
lngRowsCount = msflex.Rows
lngColumnsCount = msflex.Cols
For lngRow = 1 To lngRowsCount
For lngColumn = 1 To lngColumnsCount
strtext = msflex.TextMatrix(lngRow - 1, lngColumn - 1)
If IsNull(strtext) = False And strtext <> "" Then
xlssheet.Cells(lngRow, lngColumn) = strtext
End If
Next
Next
xlsworkbook.SaveAs Form2.CD1.FileName
xlsworkbook.Close = True
xlsapp.Quit
Set xlssheet = Nothing
Set xlsworkbook = Nothing
Set xlsapp = Nothing
Else
lRet = -1
End If
If lRet = -1 Then
Form2.Print MsgBox("导出失败！", 64, "提示")
Form2.Cls
End If
ErrHandle:
End Sub
Public Sub txtread()
Dim lRet As Long
On Error GoTo ErrHandle
Form2.CD1.Filter = "文本文件 (*.txt)|*.TXT|"
Form2.CD1.InitDir = App.Path
Form2.CD1.FilterIndex = 1
Form2.CD1.ShowOpen
If (Form2.CD1.FileName <> "") And Form2.CD1.FileName <> "Canceled" Then
Form2.Show
Dim str As String, str1() As String, i As Long, j As Long
Form2.MSFlexGrid1.Rows = 0
Form2.MSFlexGrid1.Cols = 0
Open Form2.CD1.FileName For Input As #1
Line Input #1, str
str1 = Split(LTrim(str), vbTab)
Form2.MSFlexGrid1.Cols = UBound(str1) + 1
Seek 1, 1
Do While Not EOF(1)
Line Input #1, str
str1 = Split(LTrim(str), vbTab)
Form2.MSFlexGrid1.AddItem vbNullString
For j = LBound(str1) To UBound(str1)
Form2.MSFlexGrid1.TextMatrix(i, j) = CStr((str1(j)))
Next
i = i + 1
Loop
Close #1
End If
Exit Sub
ErrHandle:
End Sub
Public Sub txtsave(msflex As Object)
On Error GoTo ErrHandle
Dim lRet As Long
Form2.CD1.Filter = "txt文件|*.txt;*.txt"
Form2.CD1.InitDir = App.Path
Form2.CD1.FileName = ""
Form2.CD1.ShowSave
If (Form2.CD1.FileName <> "") And Form2.CD1.FileName <> "Canceled" Then
Open Form2.CD1.FileName For Output As #2
Dim i As Long, j As Long
For i = 0 To msflex.Rows - 1
For j = 0 To msflex.Cols - 1
Print #2, msflex.TextMatrix(i, j); IIf(j = msflex.Cols - 1, "", vbTab);
Next
If i < msflex.Rows - 1 Then Print #2,
Next
Close #2
Else
lRet = -1
End If
If lRet <> -1 Then
Form2.Print MsgBox("导出成功！", 64, "提示")
Form2.Cls
Else
Form2.Print MsgBox("导出失败！", 64, "提示")
Form1.Cls
End If
ErrHandle:
End Sub
Public Sub printerv()
On Error GoTo ErrFlag
Dim i As Long, j As Long
Dim ScaleValue As Long
Dim dblLeft As Double, dblTop As Double
ScaleValue = 567
With Form2.CD1
.CancelError = True
.Flags = cdlPDPrintSetup
' .Action = &H5
.ShowPrinter
End With
With Printer
.Orientation = Form2.CD1.Orientation
.Copies = Form2.CD1.Copies
.ScaleMode = vbCentimeters
dblLeft = 0.5
dblTop = 0.5
For i = 0 To Form2.MSFlexGrid1.Rows - 1
Form2.MSFlexGrid1.Row = i
dblTop = dblTop + Form2.MSFlexGrid1.RowHeight(i) / ScaleValue
If dblTop > (Printer.ScaleHeight - 1 - .TextHeight("ABC")) Then
dblTop = 0.5
.NewPage
End If
dblLeft = 0.5
For j = 0 To Form2.MSFlexGrid1.Cols - 1
.CurrentY = dblTop
.CurrentX = dblLeft
dblLeft = dblLeft + Form2.MSFlexGrid1.colwidth(j) / ScaleValue
Form2.MSFlexGrid1.Col = j
Printer.Print Form2.MSFlexGrid1.Text
Next
Next
End With
Printer.EndDoc
Printer.KillDoc
ErrFlag:
End Sub
'*****************************************************文件储存到数组中***************************************************************
Public Function read(msf() As String, MSFLexgrid As Object)
Dim lRet As Long
On Error GoTo ErrHandle
Form2.CD1.Filter = "文本文件 (*.txt)|*.TXT|Excel 文件 (*.xls)|*.xls|Excel 文件 (*.xlsx)|*.xlsx|csv文件 (*.csv)|*.csv"
Form2.CD1.InitDir = App.Path
Form2.CD1.FilterIndex = 1
Form2.CD1.ShowOpen
If Mid(Form2.CD1.FileTitle, InStr(1, Form2.CD1.FileTitle, "."), Len(Form2.CD1.FileTitle)) = ".txt" Then
Dim str As String, str1() As String, i As Long, j As Long
MSFLexgrid.Rows = 0
MSFLexgrid.Cols = 0
Open Form2.CD1.FileName For Input As #1
Line Input #1, str
str1 = Split(LTrim(str), vbTab)
MSFLexgrid.Cols = UBound(str1) + 1
Seek 1, 1
Do While Not EOF(1)
Line Input #1, str
str1 = Split(LTrim(str), vbTab)
MSFLexgrid.AddItem vbNullString
For j = LBound(str1) To UBound(str1)
MSFLexgrid.TextMatrix(i, j) = CStr((str1(j)))
Next
i = i + 1
Loop
Close #1
Else
Dim xlsapp As Object
Dim xlsworkbook As Object
Dim xlssheet As Object
MSFLexgrid.Clear
MSFLexgrid.Rows = 2
MSFLexgrid.Cols = 2
Set xlsapp = CreateObject("Excel.Application")
xlsapp.DisplayAlerts = False
Set xlsworkbook = xlsapp.Workbooks.Open(Form2.CD1.FileName, False, True)
For Each xlssheet In xlsworkbook.Worksheets
Set xlssheet = xlsworkbook.Worksheets(xlssheet.Name) ' SheetNames(I)
Set xlsrange = xlssheet.UsedRange
ReDim ArrayCells(1 To xlsrange.Rows.Count, 1 To xlsrange.Columns.Count)
ArrayCells = xlsrange.Value ' ArrayCells = RNG.Formula 传值
Exit For
Next
MSFLexgrid.Rows = UBound(ArrayCells, 1)
MSFLexgrid.Cols = UBound(ArrayCells, 2)
For R = 0 To UBound(ArrayCells, 1) - 1
For C = 0 To UBound(ArrayCells, 2) - 1
MSFLexgrid.TextMatrix(R, C) = CStr(ArrayCells(R + 1, C + 1))
Next
Next
xlsworkbook.Close
Set xlsworkbook = Nothing
Set xlssheet = Nothing
Set xlsrange = Nothing
xlsapp.DisplayAlerts = True
End If
ReDim msf(MSFLexgrid.Rows - 1, MSFLexgrid.Cols - 1)
For i = 0 To MSFLexgrid.Rows - 1
For j = 0 To MSFLexgrid.Cols - 1
msf(i, j) = MSFLexgrid.TextMatrix(i, j)
Next
Next
ErrHandle:
End Function
Public Sub xlsread()
Dim lRet As Long
Form2.CD1.Filter = "Excel 文件 (*.xls)|*.xls|Excel 文件 (*.xlsx)|*.xlsx|csv文件 (*.csv)|*.csv"
Form2.CD1.InitDir = App.Path
Form2.CD1.FilterIndex = 1
Form2.CD1.ShowOpen
If (Form2.CD1.FileName <> "") And Form2.CD1.FileName <> "Canceled" Then
Dim xlsapp As Object
Dim xlsworkbook As Object
Dim xlssheet As Object
Set xlsapp = CreateObject("Excel.Application")
xlsapp.DisplayAlerts = False
Set xlsworkbook = xlsapp.Workbooks.Open(Form2.CD1.FileName, False, True)
For Each xlssheet In xlsworkbook.Worksheets
Form2.Combo1.AddItem xlssheet.Name
Next
xlsapp.Quit
Set xlsapp = Nothing
End If
End Sub
'**************************************文件保存**********************************************************************
Public Sub xlssave(msflex As Object)
On Error GoTo ErrHandle
Dim lRet As Long
Form2.CD1.Flags = cdlOFNOverwritePrompt
Form2.CD1.Filter = "Excel 文件(*.xls)|*.xls|Excel 文件(*.xlsx)|*.xlsx|csv文件(*.csv)|*.csv"
Form2.CD1.InitDir = App.Path
Form2.CD1.FileName = ""
Form2.CD1.ShowSave
If (Form2.CD1.FileName <> "") And Form2.CD1.FileName <> "Canceled" Then
Dim xlsapp As Object
Dim xlsworkbook As Object
Dim xlssheet As Object
Set xlsapp = CreateObject("Excel.Application")
Set xlsworkbook = xlsapp.Workbooks.Add
Set xlssheet = xlsworkbook.Worksheets(1)
Dim lngRowsCount As Long, lngColumnsCount As Long, lngRow As Long, lngColumn As Long
Dim strtext As String
lngRowsCount = msflex.Rows
lngColumnsCount = msflex.Cols
For lngRow = 1 To lngRowsCount
For lngColumn = 1 To lngColumnsCount
strtext = msflex.TextMatrix(lngRow - 1, lngColumn - 1)
If IsNull(strtext) = False And strtext <> "" Then
xlssheet.Cells(lngRow, lngColumn) = strtext
End If
Next
Next
xlsworkbook.SaveAs Form2.CD1.FileName
xlsworkbook.Close = True
xlsapp.Quit
Set xlssheet = Nothing
Set xlsworkbook = Nothing
Set xlsapp = Nothing
Else
lRet = -1
End If
If lRet = -1 Then
Form2.Print MsgBox("导出失败！", 64, "提示")
Form2.Cls
End If
ErrHandle:
End Sub
Public Sub txtread()
Dim lRet As Long
On Error GoTo ErrHandle
Form2.CD1.Filter = "文本文件 (*.txt)|*.TXT|"
Form2.CD1.InitDir = App.Path
Form2.CD1.FilterIndex = 1
Form2.CD1.ShowOpen
If (Form2.CD1.FileName <> "") And Form2.CD1.FileName <> "Canceled" Then
Form2.Show
Dim str As String, str1() As String, i As Long, j As Long
Form2.MSFlexGrid1.Rows = 0
Form2.MSFlexGrid1.Cols = 0
Open Form2.CD1.FileName For Input As #1
Line Input #1, str
str1 = Split(LTrim(str), vbTab)
Form2.MSFlexGrid1.Cols = UBound(str1) + 1
Seek 1, 1
Do While Not EOF(1)
Line Input #1, str
str1 = Split(LTrim(str), vbTab)
Form2.MSFlexGrid1.AddItem vbNullString
For j = LBound(str1) To UBound(str1)
Form2.MSFlexGrid1.TextMatrix(i, j) = CStr((str1(j)))
Next
i = i + 1
Loop
Close #1
End If
Exit Sub
ErrHandle:
End Sub
Public Sub txtsave(msflex As Object)
On Error GoTo ErrHandle
Dim lRet As Long
Form2.CD1.Filter = "txt文件|*.txt;*.txt"
Form2.CD1.InitDir = App.Path
Form2.CD1.FileName = ""
Form2.CD1.ShowSave
If (Form2.CD1.FileName <> "") And Form2.CD1.FileName <> "Canceled" Then
Open Form2.CD1.FileName For Output As #2
Dim i As Long, j As Long
For i = 0 To msflex.Rows - 1
For j = 0 To msflex.Cols - 1
Print #2, msflex.TextMatrix(i, j); IIf(j = msflex.Cols - 1, "", vbTab);
Next
If i < msflex.Rows - 1 Then Print #2,
Next
Close #2
Else
lRet = -1
End If
If lRet <> -1 Then
Form2.Print MsgBox("导出成功！", 64, "提示")
Form2.Cls
Else
Form2.Print MsgBox("导出失败！", 64, "提示")
Form1.Cls
End If
ErrHandle:
End Sub
Public Sub printerv()
On Error GoTo ErrFlag
Dim i As Long, j As Long
Dim ScaleValue As Long
Dim dblLeft As Double, dblTop As Double
ScaleValue = 567
With Form2.CD1
.CancelError = True
.Flags = cdlPDPrintSetup
' .Action = &H5
.ShowPrinter
End With
With Printer
.Orientation = Form2.CD1.Orientation
.Copies = Form2.CD1.Copies
.ScaleMode = vbCentimeters
dblLeft = 0.5
dblTop = 0.5
For i = 0 To Form2.MSFlexGrid1.Rows - 1
Form2.MSFlexGrid1.Row = i
dblTop = dblTop + Form2.MSFlexGrid1.RowHeight(i) / ScaleValue
If dblTop > (Printer.ScaleHeight - 1 - .TextHeight("ABC")) Then
dblTop = 0.5
.NewPage
End If
dblLeft = 0.5
For j = 0 To Form2.MSFlexGrid1.Cols - 1
.CurrentY = dblTop
.CurrentX = dblLeft
dblLeft = dblLeft + Form2.MSFlexGrid1.colwidth(j) / ScaleValue
Form2.MSFlexGrid1.Col = j
Printer.Print Form2.MSFlexGrid1.Text
Next
Next
End With
Printer.EndDoc
Printer.KillDoc
ErrFlag:
End Sub
'*****************************************************文件储存到数组中***************************************************************
Public Function read(msf() As String, MSFLexgrid As Object)
Dim lRet As Long
On Error GoTo ErrHandle
Form2.CD1.Filter = "文本文件 (*.txt)|*.TXT|Excel 文件 (*.xls)|*.xls|Excel 文件 (*.xlsx)|*.xlsx|csv文件 (*.csv)|*.csv"
Form2.CD1.InitDir = App.Path
Form2.CD1.FilterIndex = 1
Form2.CD1.ShowOpen
If Mid(Form2.CD1.FileTitle, InStr(1, Form2.CD1.FileTitle, "."), Len(Form2.CD1.FileTitle)) = ".txt" Then
Dim str As String, str1() As String, i As Long, j As Long
MSFLexgrid.Rows = 0
MSFLexgrid.Cols = 0
Open Form2.CD1.FileName For Input As #1
Line Input #1, str
str1 = Split(LTrim(str), vbTab)
MSFLexgrid.Cols = UBound(str1) + 1
Seek 1, 1
Do While Not EOF(1)
Line Input #1, str
str1 = Split(LTrim(str), vbTab)
MSFLexgrid.AddItem vbNullString
For j = LBound(str1) To UBound(str1)
MSFLexgrid.TextMatrix(i, j) = CStr((str1(j)))
Next
i = i + 1
Loop
Close #1
Else
Dim xlsapp As Object
Dim xlsworkbook As Object
Dim xlssheet As Object
MSFLexgrid.Clear
MSFLexgrid.Rows = 2
MSFLexgrid.Cols = 2
Set xlsapp = CreateObject("Excel.Application")
xlsapp.DisplayAlerts = False
Set xlsworkbook = xlsapp.Workbooks.Open(Form2.CD1.FileName, False, True)
For Each xlssheet In xlsworkbook.Worksheets
Set xlssheet = xlsworkbook.Worksheets(xlssheet.Name) ' SheetNames(I)
Set xlsrange = xlssheet.UsedRange
ReDim ArrayCells(1 To xlsrange.Rows.Count, 1 To xlsrange.Columns.Count)
ArrayCells = xlsrange.Value ' ArrayCells = RNG.Formula 传值
Exit For
Next
MSFLexgrid.Rows = UBound(ArrayCells, 1)
MSFLexgrid.Cols = UBound(ArrayCells, 2)
For R = 0 To UBound(ArrayCells, 1) - 1
For C = 0 To UBound(ArrayCells, 2) - 1
MSFLexgrid.TextMatrix(R, C) = CStr(ArrayCells(R + 1, C + 1))
Next
Next
xlsworkbook.Close
Set xlsworkbook = Nothing
Set xlssheet = Nothing
Set xlsrange = Nothing
xlsapp.DisplayAlerts = True
End If
ReDim msf(MSFLexgrid.Rows - 1, MSFLexgrid.Cols - 1)
For i = 0 To MSFLexgrid.Rows - 1
For j = 0 To MSFLexgrid.Cols - 1
msf(i, j) = MSFLexgrid.TextMatrix(i, j)
Next
Next
ErrHandle:
End Function
