關于從MSHFlexGrid 導數據到Excel中

1.MSHFlexGrid 導數據到已做好格式的Excel中,首先要打開該excel﹐但我不知道怎么打開一個已存在的excel。
2.在excel中有一文本框﹐需要從mshflexgrd中導入數據,vb里是怎樣寫的!

解决方案 »

  1.   

    Workbooks.Open("C:\MyFolder\MyBook.xls")
      

  2.   

    给你一个从MSFlexGrid导到EXCEL的函数，你自己改成MSHFlexGrid的：
    Option Explicit#If Win16 Then
        DefInt A-Z
        ' Required Win16 API declarations
        Private Declare Function FindWindow Lib "User" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Integer
        Public Declare Function SetActiveWindow Lib "User" (ByVal hwnd As Integer) As Integer
        Public Declare Function ShowWindow Lib "User" (ByVal hwnd As Integer, ByVal nCmdShow As Integer) As Integer
        Private Declare Function GetWindow Lib "User" (ByVal hwnd As Integer, ByVal wCmd As Integer) As Integer
        Private Declare Function GetWindowText Lib "User" (ByVal hwnd As Integer, ByVal lpString As String, ByVal aint As Integer) As Integer
        Private Declare Function GetParent Lib "User" (ByVal hwnd As Integer) As Integer
        Private Declare Function IsIconic Lib "User" (ByVal hwnd As Integer) As Integer
    #ElseIf Win32 Then
        DefLng A-Z
        ' Required Win32 API declarations
        Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
        Public Declare Function SetActiveWindow Lib "user32" Alias "SetForegroundWindow" (ByVal hwnd As Long) As Long
        Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
        Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
        Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
        Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
        Private Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long
    #End If
    Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
    Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    Public Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
    Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
    Public Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
    Public Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
    Public Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
    Public Declare Function GetCurrentProcess Lib "kernel32" () As Long
    Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As LongPublic WinHwnd                           As Long' Constants used by FindWindowPartial
    Public Const FWP_STARTSWITH = 0
    Public Const FWP_CONTAINS = 1' Constant used by GetWindowWord to find next window
    Private Const GW_HWNDNEXT = 2Dim WhetherYouCanSaveBool                As Boolean '是否可以保存文档
    Public Type LUID
        LowPart As Long
        HighPart As Long
    End Type
    Public Type TOKEN_PRIVILEGES
        PrivilegeCount As Long
        TheLuid As LUID
        Attributes As Long
    End Type
    Public Function OutToExcel(MG As MSFlexGrid, Capt As String, DateStr As String, MC As MSChart) As Boolean
        OutToExcel = False
        Dim l As Long, m As Long, i As Long, j As Long, k As Long, tmpA As String, tmpB As String, TmpF As Long, TmpL As Long, kk As Long
        l = MG.Cols: m = MG.Rows
        Dim MovCharTop As Long
        MovCharTop = 40
        If l = 0 Or m = 0 Then Exit Function
        WinHwnd = FindWindowPartial("Microsoft Excel", FWP_CONTAINS)
        If WinHwnd <> 0 Then
            If MsgBox(" Microsoft Excel 正在被使用,是否关闭?", vbQuestion + vbYesNo, "关闭") = vbYes Then
                ProcessTerminate , WinHwnd
            Else
                '            Exit Function
            End If
        End If
        '10-222lu==========================================================================
        WhetherYouCanSaveBool = False '在Excel退出时是True
        App.OleRequestPendingMsgText = "正在启动Excel,可能需要几秒钟......"
        App.OleRequestPendingMsgTitle = "请等待......."
        App.OleRequestPendingTimeout = 1
        '10-222lu==========================================================================
        FrmMain.VAProgressBar.Visible = True: FrmMain.VAProgressBar.Value = 0
        Call SetAnimateCursor(App.Path & "\ico\WAIT07.cur")
        FrmProgress.LBLProgress.Caption = "数据导出中，请稍候... ..."
        FrmProgress.Show
        DoEvents
        Dim ObjExcel As Object
        Set ObjExcel = CreateObject("Excel.Application")
        ObjExcel.WindowState = xlMaximized
        On Error GoTo objError
        ObjExcel.Workbooks.Add
        With ObjExcel.ActiveSheet
            With .Cells
                .WrapText = True
                .Font.Size = MG.Font.Size
                .VerticalAlignment = xlCenter
            End With
            .Range("A1:G1").MergeCells = True
            .Cells(1, 1) = Capt: .Cells(1, 1).HorizontalAlignment = xlCenter
            .Cells(1, 1).Font.Size = 12: .Cells(1, 1).Font.Bold = True
            .Rows(1).RowHeight = 30
            .Range("H1:I1").MergeCells = True
            .Cells(1, 8) = DateStr: .Cells(1, 8).VerticalAlignment = xlBottom: .Cells(1, 8).HorizontalAlignment = xlRight
            .Cells(1, 8).Font.Size = 9: .Cells(1, 8).Font.Bold = False
            k = 0
            For i = 1 To l
                If MG.ColWidth(i - 1) > 0 Then
                    k = k + 1
                    .Columns(k).ColumnWidth = MG.ColWidth(i - 1) / 120
                End If
            Next i
      

  3.   

    For j = 0 To 3
                If MG.Cols > j Then
                    If MG.MergeCol(j) Then
                        MG.Col = j
                        k = 0: tmpA = "": TmpF = -1: TmpL = -1
                        For i = 1 To MG.Rows
                            If MG.RowHeight(i - 1) > 0 Then
                                k = k + 1: MG.Row = i - 1
                                tmpB = Trim(MG.Text)
                                If tmpB = tmpA Then
                                    TmpL = k
                                Else
                                    If TmpF = -1 Or TmpL = -1 Or TmpF = TmpL Then
                                    Else
                                        .Range(CalExcelLNum(j + 1) & (TmpF + 1) & ":" & CalExcelLNum(j + 1) & (TmpL + 1)).MergeCells = True
                                    End If
                                    TmpF = k: tmpA = tmpB: TmpL = -1
                                End If
                            End If
                        Next i
                        If TmpF = -1 Or TmpL = -1 Or TmpF = TmpL Then
                        Else
                            .Range(CalExcelLNum(j + 1) & (TmpF + 1) & ":" & CalExcelLNum(j + 1) & (TmpL + 1)).MergeCells = True
                        End If
                    End If
                End If
            Next j        For j = 0 To 3
                If MG.Rows > j Then
                    If MG.MergeRow(j) Then
                        MG.Row = j
                        k = 0: tmpA = "": TmpF = -1: TmpL = -1
                        For i = 1 To MG.Cols
                            If MG.ColWidth(i - 1) > 0 Then
                                k = k + 1: MG.Col = i - 1
                                tmpB = Trim(MG.Text)
                                If tmpB = tmpA Then
                                    TmpL = k
                                Else
                                    If TmpF = -1 Or TmpL = -1 Or TmpF = TmpL Then
                                    Else
                                        .Range(CalExcelLNum(TmpF) & (j + 2) & ":" & CalExcelLNum(TmpL) & (j + 2)).MergeCells = True
                                    End If
                                    TmpF = k: tmpA = tmpB: TmpL = -1
                                End If
                            End If
                        Next i
                        If TmpF = -1 Or TmpL = -1 Or TmpF = TmpL Then
                        Else
                            .Range(CalExcelLNum(TmpF) & (j + 2) & ":" & CalExcelLNum(TmpL) & (j + 2)).MergeCells = True
                        End If
                    End If
                End If
            Next j        k = 0
            For i = 1 To m
                FrmMain.VAProgressBar.Value = Int((i * 100) / m)
                If MG.RowHeight(i - 1) > 0 Then
                    k = k + 1
                    .Rows(k + 1).RowHeight = MG.RowHeight(i - 1) / 20
                    MovCharTop = MovCharTop + .Rows(k + 1).RowHeight
                    kk = 0
                    For j = 1 To l
                        If MG.ColWidth(j - 1) > 0 Then
                            kk = kk + 1
                            MG.Col = j - 1: MG.Row = i - 1
                            Select Case MG.CellAlignment
                            Case 1:
                                .Cells(k + 1, kk).HorizontalAlignment = xlLeft
                            Case 4:
                                .Cells(k + 1, kk).HorizontalAlignment = xlCenter
                            Case 7:
                                .Cells(k + 1, kk).HorizontalAlignment = xlRight
                            End Select
                            .Cells(k + 1, kk) = MG.Text
                        End If
                    Next j
                End If
            Next i        With .Range("A2:" & CalExcelLNum(kk) & (k + 1))
                With .Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With .Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With .Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With .Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With .Borders(xlInsideVertical)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With .Borders(xlInsideHorizontal)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
            End With
        End With
        Dim TmpStr As String, TmpValue As String, TmpSS As String
        If MC.Visible And MC.RowCount > 0 And MC.ColumnCount > 0 And MC.RowCount < 50 Then
            '画图
            With ObjExcel
                .Charts.Add
                '            If MC.ChartType = VtChChartType2dLine Then
                '                .ActiveChart.ChartType = xlLine
                '            Else
                .ActiveChart.ChartType = xlColumnClustered
                '            End If
                If MC.ColumnCount > 1 Then
                    For j = 2 To MC.ColumnCount
                        .ActiveChart.SeriesCollection.NewSeries
                    Next j
                End If
                TmpStr = "={"
                For i = 1 To MC.RowCount
                    MC.Row = i
                    TmpSS = MC.RowLabel
                    If TmpSS = "" Then
                        TmpSS = ""
                    Else
                        TmpSS = Val(TmpSS)
                    End If
                    TmpStr = TmpStr & """" & TmpSS & ""","
                Next i
                TmpStr = left(TmpStr, Len(TmpStr) - 1)
                TmpStr = TmpStr & "}"
                For j = 1 To MC.ColumnCount
                    MC.Column = j
                    .ActiveChart.SeriesCollection(j).XValues = TmpStr
                    TmpValue = "={"
                    For i = 1 To MC.RowCount
                        MC.Row = i
                        TmpValue = TmpValue & Val(Format(Val(MC.Data), "Scientific")) & ","
                    Next i
                    TmpValue = left(TmpValue, Len(TmpValue) - 1)
                    TmpValue = TmpValue & "}"
                    .ActiveChart.SeriesCollection(j).Values = TmpValue
                    .ActiveChart.SeriesCollection(j).Name = "=""" & MC.ColumnLabel & """"
                Next j
                .ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"
                With .ActiveChart
                    .HasTitle = False
                    .Axes(xlCategory, xlPrimary).HasTitle = True
                    .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = " "
                    .Axes(xlValue, xlPrimary).HasTitle = True
                    If MC.Plot.Axis(VtChAxisIdY).AxisTitle <> "" Then
                        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = MC.Plot.Axis(VtChAxisIdY).AxisTitle
                    Else
                        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = " "
                    End If
                    .HasAxis(xlCategory, xlPrimary) = True
                    .HasAxis(xlValue, xlPrimary) = True
      

  4.   

    .Axes(xlCategory, xlPrimary).CategoryType = xlAutomatic
                    With .Axes(xlCategory)
                        .HasMajorGridlines = True
                        .HasMinorGridlines = False
                    End With
                    With .Axes(xlValue)
                        .HasMajorGridlines = True
                        .HasMinorGridlines = False
                    End With
                    With .Axes(xlCategory).MajorGridlines.Border
                        .ColorIndex = 57
                        .Weight = xlHairline
                        .LineStyle = xlDot
                    End With
                End With
                .ActiveSheet.Shapes("图表 1").IncrementLeft 10 - .ActiveSheet.Shapes("图表 1").left
                .ActiveSheet.Shapes("图表 1").IncrementTop MovCharTop - .ActiveSheet.Shapes("图表 1").top
            End With
            If MC.ChartType = VtChChartType2dLine Then
                ObjExcel.ActiveChart.ChartType = xlLine
            Else
                ObjExcel.ActiveChart.ChartType = xlColumnClustered
            End If
        End If    ObjExcel.Visible = True
        WinHwnd = FindWindowPartial("Microsoft Excel", FWP_CONTAINS)
        If WinHwnd <> 0 Then
            '置前
            SetWindowPos WinHwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE + SWP_SHOWWINDOW
            '独占
            'GetProcessID WinHwnd
        End If
        'lu10-21=================================================================    OutToExcel = True
        Set ObjExcel = Nothing
        FrmMain.VAProgressBar.Visible = False
        Call SetAnimateCursor(App.Path & "\ico\normal01.cur")
        Unload FrmProgress
        Exit FunctionobjError:
        Set ObjExcel = Nothing '10-222lu======
        FrmMain.VAProgressBar.Visible = False
        Call SetAnimateCursor(App.Path & "\ico\normal01.cur")
        Unload FrmProgress
        WhetherYouCanSaveBool = True '出错就是Excel没有调出来
        If Err <> 429 Then
            MsgBox Str$(Err) & Error$
            Set ObjExcel = Nothing
            Exit Function
        Else
            Resume Next
        End IfPrintCanceled:
    End Function
    Public Function FindWindowPartial(TitleStart$, Method%) As Long
        Dim hWndTmp 'As SysInt
        Dim nRet 'As SysInt
        Dim TitleTmp As String
        '
        ' Find first window and loop through all subsequent
        ' windows in master window list.
        '
        hWndTmp = FindWindow(vbNullString, vbNullString)
        Do Until hWndTmp = 0
            '
            ' Make sure this window has no parent.
            '
            If GetParent(hWndTmp) = 0 Then
                '
                ' Retrieve caption text from current window.
                '
                TitleTmp = Space(256)
                nRet = GetWindowText(hWndTmp, TitleTmp, Len(TitleTmp))
                If nRet Then
                    '
                    ' Clean up return string, preparing for
                    ' case-insensitive comparison.
                    '
                    TitleTmp = UCase(left(TitleTmp, nRet))
                    'TitleTmp = Left(TitleTmp, nRet)                '
                    ' Use appropriate method to determine if
                    ' current window's caption either starts
                    ' with or contains passed string.
                    '
                    Select Case Method
                    Case FWP_STARTSWITH
                        If InStr(TitleTmp, UCase(TitleStart)) = 1 Then
                            'If InStr(TitleTmp, TitleStart) = 1 Then
                            FindWindowPartial = hWndTmp
                            Exit Do
                        End If
                    Case FWP_CONTAINS
                        If InStr(TitleTmp, UCase(TitleStart)) Then
                            'If InStr(TitleTmp, TitleStart) Then
                            FindWindowPartial = hWndTmp
                            Exit Do
                        End If
                    End Select
                End If
            End If
            '
            ' Get next window in master window list and continue.
            '
            hWndTmp = GetWindow(hWndTmp, GW_HWNDNEXT)
        Loop
    End Function
    Function ProcessTerminate(Optional lProcessID As Long, Optional lHwndWindow As Long) As Boolean
        Dim lhwndProcess As Long
        Dim lExitCode As Long
        Dim lRetVal As Long
        Dim lhThisProc As Long
        Dim lhTokenHandle As Long
        Dim tLuid As LUID
        Dim tTokenPriv As TOKEN_PRIVILEGES, tTokenPrivNew As TOKEN_PRIVILEGES
        Dim lBufferNeeded As Long    Const PROCESS_ALL_ACCESS = &H1F0FFF, PROCESS_TERMINATE = &H1
        Const ANYSIZE_ARRAY = 1, TOKEN_ADJUST_PRIVILEGES = &H20
        Const TOKEN_QUERY = &H8, SE_DEBUG_NAME As String = "SeDebugPrivilege"
        Const SE_PRIVILEGE_ENABLED = &H2    On Error Resume Next
        If lHwndWindow Then
            'Get the process ID from the window handle
            lRetVal = GetWindowThreadProcessId(lHwndWindow, lProcessID)
        End If    If lProcessID Then
            'Give Kill permissions to this process
            lhThisProc = GetCurrentProcess        OpenProcessToken lhThisProc, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, lhTokenHandle
            LookupPrivilegeValue "", SE_DEBUG_NAME, tLuid
            'Set the number of privileges to be change
            tTokenPriv.PrivilegeCount = 1
            tTokenPriv.TheLuid = tLuid
            tTokenPriv.Attributes = SE_PRIVILEGE_ENABLED
            'Enable the kill privilege in the access token of this process
            AdjustTokenPrivileges lhTokenHandle, False, tTokenPriv, Len(tTokenPrivNew), tTokenPrivNew, lBufferNeeded        'Open the process to kill
            lhwndProcess = OpenProcess(PROCESS_TERMINATE, 0, lProcessID)        If lhwndProcess Then
                'Obtained process handle, kill the process
                ProcessTerminate = CBool(TerminateProcess(lhwndProcess, lExitCode))
                Call CloseHandle(lhwndProcess)
            End If
        End If
        On Error GoTo 0
    End Function
    Private Function CalExcelLNum(l As Long) As String '计算Excel中的列值
        If l <= 0 Then Exit Function
        Dim i As Long, j As Long, TmpStr As String
        i = (l - 1) Mod 26: j = Int((l - 1) / 26)
        TmpStr = Chr(Asc("A") + i)
        If j > 0 Then
            TmpStr = Chr(Asc("A") + j - 1) & TmpStr
        End If
        CalExcelLNum = TmpStr
    End Function
      

  5.   

    Dim ex As New Excel.Application
        Dim st As Excel.Worksheet
        Dim wb As Excel.Workbook    StrTmpName = App.Path & "test.xls"    Set wb = ex.Workbooks.Open(StrTmpName)
        ex.Visible = False
        Set st = wb.Sheets("sheet1")...............
        在设计模式下双击文件框，可以看到文件框的属性设置，
    方法就跟vb中一样了
        ex.Sheet1.TextBox1.Text = "11"
      

  6.   

    其他的都解決了﹐但是
        在设计模式下双击文件框，可以看到文件框的属性设置，
    方法就跟vb中一样了
        ex.Sheet1.TextBox1.Text = "11"我是這樣用的
    Excelapp.Sheet1.TextBox28 = "tu"
    我希望在excel中的第28個文本框中顯示"tu"
    可以我運行到這里時就出錯了