Excle难题，急待解决！望各位相助

Question

VB导出Excle,用的是DATAGRID，拥有的功能：我在DATAGRID上点击某一列，以此列排序
问题：保持刚刚排序完的状态，此时导出成EXCLE，代码怎末写是以现在DATAGRID上显示的状态导出。
就要此关键点的解决方案。

Answer 1

'用MSHFlexGrid1：
Private MyExcel As New Excel.ApplicationPrivate Sub MnSave_Click()
    Dim I As Long
    Dim j As Long
    
    On Error GoTo Handler
    With CommonDialog1
        .DialogTitle = "保存文件"
        .Filter = "excel文件(.xls)|*.xls|" '所有文件(*.*)|*.*"
        .ShowSave
    End With    MyExcel.Workbooks.Add.SaveAs CommonDialog1.filename
    MyExcel.Worksheets(1).Cells(1, 1) = "班別(Shif)："
    MyExcel.Worksheets(1).Cells(1, 2) = "線別(Line)：" & cboLine_no.Text
    MyExcel.Worksheets(1).Cells(1, 3) = "機種(Model)："
    MyExcel.Worksheets(1).Cells(1, 4) = "日期(Date)：" & DTPicker1.Value    MyExcel.Worksheets(1).Cells(2, 1) = "序號"
    MyExcel.Worksheets(1).Cells(2, 2) = "18碼"
    MyExcel.Worksheets(1).Cells(2, 3) = "不良現象"
    MyExcel.Worksheets(1).Cells(2, 4) = "不良位置"
    MyExcel.Worksheets(1).Cells(2, 5) = "備注"
    ProBarExcel.Visible = True
    Label6.Visible = True
    ProBarExcel.Min = 0
    ProBarExcel.Max = MSHFlexGrid1.Rows
    With         For I = 1 To .Rows - 1
            For j = 1 To .Cols - 1
                MyExcel.Worksheets(1).Cells(I + 2, j) = Trim(.TextMatrix(I, j - 1))
            Next j
            ProBarExcel.Value = I + 1
            DoEvents
        Next I
    End With
    ProBarExcel.Value = 0
    ProBarExcel.Visible = False
    Label6.Visible = False
    MyExcel.Workbooks.Close
    Set MyExcel = Nothing
    Exit Sub
Handler:
    MsgBox Err.Description
End Sub

Answer 2

Public Function ExporToExcel()
'*********************************************************
'* 名称：ExporToExcel
'* 功能：导出数据到EXCEL
'* 用法：ExporToExcel(sql查询字符串)
'*********************************************************
'Dim Rs_Data As New ADODB.Recordset
Dim Irowcount As Integer
Dim Icolcount As Integer
    
    Dim xlApp As New Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim xlQuery As Excel.QueryTable
    
    With s
        If .State = adStateOpen Then
            .Close
        End If
'        .ActiveConnection = Cn
        .ActiveConnection = DEMain.ConnMain
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic
'        .CursorType = adOpenDynamic
        .LockType = adLockReadOnly
'        .Source = strOpen
        .Open
        .Sort = 居民用电分级统计.DataGrid1.Columns(Mn).DataField
    End With
    With s
        If .RecordCount < 1 Then
            MsgBox ("没有记录!")
            Exit Function
        End If
        '记录总数
        Irowcount = .RecordCount
        '字段总数
        Icolcount = .Fields.Count
    End With
    
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = Nothing
    Set xlSheet = Nothing
    Set xlBook = xlApp.Workbooks().Add
    Set xlSheet = xlBook.Worksheets("sheet1")
    xlApp.Visible = True
    
    '添加查询语句，导入EXCEL数据
    Set xlQuery = xlSheet.QueryTables.Add(s, xlSheet.Range("a1"))
    
    With xlQuery
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = True
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
    End With
    
    xlQuery.FieldNames = True '显示字段名
    xlQuery.Refresh
    
    With xlSheet
        .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Name = "黑体"
        '设标题为黑体字
        .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Bold = True
        '标题字体加粗
        .Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).Borders.LineStyle = xlContinuous
        '设表格边框样式
    End With
    
    With xlSheet.PageSetup
        .LeftHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10公司名称："   ' & Gsmc
        .CenterHeader = "&""楷体_GB2312,常规""公司人员情况表&""宋体,常规""" & Chr(10) & "&""楷体_GB2312,常规""&10日 期："
        .RightHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10单位："
        .LeftFooter = "&""楷体_GB2312,常规""&10制表人："
        .CenterFooter = "&""楷体_GB2312,常规""&10制表日期："
        .RightFooter = "&""楷体_GB2312,常规""&10第&P页 共&N页"
    End With
    
    xlApp.Application.Visible = True
    Set xlApp = Nothing  '"交还控制给Excel
    Set xlBook = Nothing
    Set xlSheet = NothingEnd Function
s是我的记录集，我点击datagrid列头排序后，Mn是当前的列号（也就是DATAGRID现在按次列的字段排序）我用的是斑竹李洪根的模块，在哪设置能让EXCLE导出的时候按我现在DATAGRID的状态显示出来

Answer 3

.Sort = 居民用电分级统计.DataGrid1.Columns(Mn).DataField
这句我让他为我想按次此排序的字段但是导出的时候还是不成功。

Answer 4

顶先，再找各位前辈帮小弟一个忙，做个VB特别简单的查询系统，具体的条件我们可以QQ上聊，谢谢哪位好心人帮帮小弟，实在是急呀，再不做好，就要下岗！小弟这里有礼了！！！！！！！！！！在线等QQ11060006

Answer 5

.Sort = 居民用电分级统计.DataGrid1.Columns(Mn).DataField
这里的.SORT起身摸作用了？
哪位大学士耐心给我讲讲

Answer 6

试试我的吧,虽然不会像李版主的快速,但试试吧.
Option Explicit'Private xlApp As Excel.Application
'Private xlBook As Excel.Workbook
'Private xlSheet As Excel.Worksheet
Private xlApp As Object
Private xlBook As Object
Private xlSheet As ObjectPrivate cellValue As StringPublic strError As String
Public ExportOK As Boolean
Private Sub Class_Initialize()
    ExportOK = False
    On Error GoTo errHandle:
'    Set xlApp = CreateObject("Excel.Applaction")
    Set xlApp = New Excel.Application
    xlApp.Visible = False
    On Error GoTo errHandle:
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)
    If Val(xlApp.Application.Version) >= 8 Then
        Set xlSheet = xlApp.ActiveSheet
    Else
        Set xlSheet = xlApp
    End If
    Exit Sub
errHandle:
    Err.Raise 100001, , "建立Excel对象时发生错误:" & Err.Description & vbCr & _
        "请确保您正确了安装了Excel软件!"
End SubPublic Property Get TextMatrix(Row As Integer, Col As Integer) As Variant
    TextMatrix = xlSheet.Cells(Row, Col)
End Property
Public Property Let TextMatrix(Row As Integer, Col As Integer, Value As Variant)
    xlSheet.Cells(Row, Col) = Value
End Property'合并单元格
Public Sub MergeCell(bRow As Integer, bCol As Integer, eRow As Integer, eCol As Integer)
    xlSheet.Range(GetExcelCell(bRow, bCol) & ":" & GetExcelCell(eRow, eCol)).Select
    With xlApp.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = True
    End With
End Sub
'打印预览
Public Function PrintPreview() As Boolean
    On Error GoTo errHandle:
    xlApp.Visible = True
    xlBook.PrintPreview True
    Exit Function
errHandle:
    If Err.Number = 1004 Then
        MsgBox "尚未安装打印机,不能预览!", vbOKOnly + vbCritical, "错误"
    End If
End Function
'导出
Public Function ExportExcel() As Boolean
    xlApp.Visible = True
End Function
'画线
Public Sub DrawLine(bRow As Integer, bCol As Integer, eRow As Integer, eCol As Integer)
On Error Resume Next
    xlSheet.Range(GetExcelCell(bRow, bCol) & ":" & GetExcelCell(eRow, eCol)).Select
    xlApp.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    xlApp.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With xlApp.Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With xlApp.Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With xlApp.Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With xlApp.Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With xlApp.Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With xlApp.Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
End Sub
'导出记录集到Excel
Public Sub RstExport(Rst As ADODB.Recordset, bRow As Integer, bCol As Integer, GridHead() As String)
    Dim i As Integer, j As Integer
    For i = bCol To UBound(GridHead) + bCol
        With Me
            .TextMatrix(bRow, i) = GridHead(i - bCol)
        End With
    Next
    i = 1 + bRow
    Do While Not Rst.EOF
        For j = 1 To Rst.Fields.Count
            If Rst.Fields(j - 1).Type = adChar Or Rst.Fields(j - 1).Type = adVarChar Then
                xlSheet.Range(GetExcelCell(i, j) & ":" & GetExcelCell(i, j)).Select
                xlApp.Selection.NumberFormatLocal = "@"         '已文本方式格式化
            End If
            Me.TextMatrix(i, j) = checkNull(Rst.Fields(j - 1).Value)
        Next
        i = i + 1
        Rst.MoveNext
    Loop
End Sub'或者指定行,列号的Excel编码
Private Function GetExcelCell(Row As Integer, Col As Integer) As String
    Dim nTmp1 As Integer
    Dim nTmp2 As Integer
    Dim sTmp As String
    If Col <= 26 Then
        sTmp = Chr(Asc("A") + Col - 1)
    Else
        nTmp1 = Col \ 26
        If nTmp1 > 26 Then
            Err.Raise 100000, , "列数过大,发生错误"
            Exit Function
        Else
           sTmp = Chr(Asc("A") + nTmp1 - 1)
           nTmp1 = Col Mod 26
           sTmp = sTmp & Chr(Asc("A") + nTmp1 - 1)
        End If
    End If
    GetExcelCell = sTmp & Row
End Function
'将Null返回为空串
Private Function checkNull(s As Variant) As String
    checkNull = IIf(IsNull(s), "", s)
End FunctionPrivate Sub Class_Terminate()
    Set xlApp = Nothing
    Set xlBook = Nothing
    Set xlSheet = Nothing
End SubPublic Sub RstExport(Rst As ADODB.Recordset, bRow As Integer, bCol As Integer, GridHead() As String)
用这个功能,RST为记录集,BRow为超始行,BCol为起始列,GridHead为表头的数组

Answer 7

我一般都是用SQL采集数据时排序好了
再导出的
EXCEL中也有排序功能
你录一段宏看看
修改一下
就可以在导出到EXCEL以后再进行排序

Answer 8

行者，我录制宏，但是如何能在VB里去操作呢！？（谢谢 wumylove1234(毁于随)）

Answer 9

录制的宏实际就是一段VB代码
你只需要稍加修改就可以直接在VB里面使用