怎样把MSFlexGrid里的内容复制到一张Excel表中?

Question

RT

Answer 1

要解决的问题主要是怎样写Excel文件

Answer 2

Public Sub DateToExcel(MHFGrid As MSHFlexGrid, ByVal Sheet_Name As String)
  Dim xlApp As Excel.Application
  Dim xlBook As Excel.Workbook
  Dim xlSheet As Excel.Worksheet
  Dim i As Long, j As Long
  On Error GoTo ErrorHandle
  Set xlApp = CreateObject("Excel.Application")
  Set xlBook = xlApp.Workbooks.Add
  Set xlSheet = xlBook.Worksheets(1)
  xlSheet.Name = Sheet_Name
  xlSheet.StandardWidth = 8 '设定默认列宽
  xlSheet.Range("A1", "Z900").Font.Bold = False '设定范围内的字体是否加粗
  xlSheet.Range("A1", "Z900").Font.Size = 9 '设定字体大小
  xlSheet.Range("A1", "Z900").HorizontalAlignment = xlLeft '设定对齐方式
  xlSheet.Range("a1", "z1").Font.Bold = True '设定第一行为加粗
  For i = 0 To MHFGrid.Rows - 1
    For j = 0 To MHFGrid.Cols - 1
      xlSheet.Cells(i + 1, j + 1).Value = Trim(MHFGrid.TextMatrix(i, j))
    Next j
  Next i  xlSheet.Application.Visible = True
  'xlBook.Close
  Set xlSheet = Nothing
  Set xlBook = Nothing
  Set xlApp = Nothing
  
  Exit Sub
ErrorHandle:
  MsgBox "错误：" & Err.Number & vbCrLf & Err.Description, vbOKOnly, "运行错误"End Sub

Answer 3

Dim excelApplication As New Excel.Application
    Dim FileName As String
    Set excelWorkbook = excelApplication.Workbooks.Open(App.Path & "\spcbmxb.xls")
    Set excelSheet = excelWorkbook.Sheets("物语出品成本明细表")
    excelSheet.Cells(3, "J") = lblTC.Caption
    I = 0
    For I = 0 To (msList.Rows - 1) Step 1
        excelSheet.Cells(I + 4, "A") = msList.TextMatrix(I, 0)
        excelSheet.Cells(I + 4, "B") = msList.TextMatrix(I, 1)
        excelSheet.Cells(I + 4, "C") = msList.TextMatrix(I, 2)
        excelSheet.Cells(I + 4, "D") = msList.TextMatrix(I, 3)
        excelSheet.Cells(I + 4, "E") = msList.TextMatrix(I, 4)
        excelSheet.Cells(I + 4, "F") = msList.TextMatrix(I, 5)
        excelSheet.Cells(I + 4, "G") = msList.TextMatrix(I, 6)
        excelSheet.Cells(I + 4, "H") = msList.TextMatrix(I, 7)
        excelSheet.Cells(I + 4, "I") = msList.TextMatrix(I, 8)
        excelSheet.Cells(I + 4, "J") = msList.TextMatrix(I, 9)
    Next
    FileName = SaveExcelName("物语月份成本明细报表")
        If FileName = "" Then
          Exit Sub
        End If
    excelWorkbook.SaveCopyAs (FileName)
    excelWorkbook.Close (False)
    Set excelWorkbook = Nothing
    Set excelApplication = NothingPublic Function SaveExcelName(vFileName As String) As String
  With Saved
    .DialogTitle = "保存Excel文件"
    .FileName = vFileName
    .Filter = "Microsfot Excel 文件|*.xls"
    .InitDir = App.Path
    .ShowSave
  
  End With
    SaveExcelName = Saved.FileName
    
End Function加个commondialog控件来控制保存路径，其他的格式可以通过excel的宏来生成。