把Excel的网格畫線

Question

各位朋友,大家好,我是在前台把數據導出到Eecel中,但是excel本身沒有線條,我現在想畫上線條,就是用网格的形式,多謝
      在線等

Answer 1

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 Sub
我写的类,里面有一个画线的函数.

Answer 2

这样的不行？
"工具"->"视图"->"网格线"

Answer 3

請你先設置好Excel表格的樣式，然後再把數據發送到Excel對應的表格子裡

Answer 4

Dim xls   As New Excel.Application        'EXCEL应用程序对象
Dim xbook As Excel.Workbook          'EXCEL工作薄对象
Dim xsheet As Excel.Worksheet      'EXCEL工作表象
Set xbook = xls.Workbooks.Add
Set xsheet = xbook.Worksheets(1)xsheet.range(.Cells(1, 1), .Cells(lngRows, intCols)).Borders.LineStyle = xlContinuous
lngRows行数，intCols列数

Answer 5

Rem 自动设置字体
Ex.Range("A1:J1").Font.Bold = True
Ex.Range("A1:J1").Interior.ColorIndex = 15
Rem 自动设置列宽
Set objRange = Ex.ActiveCell.EntireColumn
objRange.AutoFit
Rem 画线
With Ex.Range("A1:J" & StrGrid.Rows).Borders
    .LineStyle = xlContinuous
    .Weight = xlThin
End WithEx.Visible = True
Set Ex = Nothing

Answer 6

二樓的朋友,你的這個過程中的gridhead()這個參數是什么意思
Public Sub RstExport(Rst As ADODB.Recordset, bRow As Integer, bCol As Integer, GridHead() As String)
兄弟比較笨請指點,多謝

Answer 7

老兄,我不是告訴你,在Excel中,錄制宏,再設置一下單元格的框線.
然后按Alt + F11,代碼都在里面.

Answer 8

Sub Macro1()
'
' Macro1 Macro
' CatchWind 在 2005/1/26 錄製的巨集
''
    Range("A1:B3").Select         '選擇A1到B3單元格
    With Selection.Borders(xlEdgeLeft) '左框線
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)  '上框線
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
End Sub

Answer 9

晕死.
你没有看到我上面的类代码吗???可以像使用MSHflexgrid一样操纵Excel.
支持直接导出记录集.也许下一步还可以添加上导出ListView,Mhsflexgrid,DataGrid等等.