VB convert to Ms Excel

Visual Basic To Excel

Program ini di gunakan untuk mengconvert data yang ada di tabel ke dalam bentuk Ms excel.

Dim exapp As Excel.Application

Dim exbook As Excel.Workbooks

Dim exsheet As Excel.Worksheet

Private Sub Command1_Click()

Dim no As Integer

exsheet.Range("B2").ColumnWidth = 15.5

exsheet.Range("C2").ColumnWidth = 25

exsheet.Range("D2").ColumnWidth = 30

exsheet.Range("E2").ColumnWidth = 8.5

exsheet.Range("F2").ColumnWidth = 8.5

With exsheet.Range("B2:F2")

    .Font.ColorIndex = 3

    .Font.Bold = True

    .HorizontalAlignment = xlCenter

    

    .Borders(xlDiagonalUp).LineStyle = xlNone

    .Borders(xlDiagonalDown).LineStyle = xlNone

    

    .Borders(xlEdgeBottom).LineStyle = xlContinuous

    .Borders(xlEdgeBottom).ColorIndex = xlAutomatic

    .Borders(xlEdgeBottom).Weight = xlThick

    

    .Borders(xlEdgeLeft).LineStyle = xlContinuous

    .Borders(xlEdgeLeft).ColorIndex = xlAutomatic

    .Borders(xlEdgeLeft).Weight = xlThick

    .Borders(xlEdgeRight).LineStyle = xlContinuous

    .Borders(xlEdgeRight).ColorIndex = xlAutomatic

    .Borders(xlEdgeRight).Weight = xlThick

    

    .Borders(xlEdgeTop).LineStyle = xlContinuous

    .Borders(xlEdgeTop).ColorIndex = xlAutomatic

    .Borders(xlEdgeTop).Weight = xlThick

    

    .Borders(xlInsideVertical).LineStyle = xlContinuous

    .Borders(xlInsideVertical).ColorIndex = xlAutomatic

    .Borders(xlInsideVertical).Weight = xlThin

    .Interior.ColorIndex = 35

    .Interior.Pattern = xlSolid

End With

    exsheet.Cells(2, 2) = "Asset"

    exsheet.Cells(2, 3) = "Descr"

    exsheet.Cells(2, 4) = "Dept"

    exsheet.Cells(2, 5) = "Loc"

    exsheet.Cells(2, 6) = "Thn"

If Not (Adodc1.Recordset.RecordCount = 0) Then

ProgressBar1.Max = Adodc1.Recordset.RecordCount * 5

With Adodc1.Recordset

    .MoveFirst

    no = 3

    Do While (Not .EOF)

        exsheet.Cells(no, 2) = .Fields(0)

        exsheet.Cells(no, 3) = .Fields(1)

        exsheet.Cells(no, 4) = .Fields(2)

        exsheet.Cells(no, 5) = .Fields(3)

        exsheet.Cells(no, 6) = .Fields(4)

        .MoveNext

        If (no Mod 2) = 0 Then

        exsheet.Range("B" & no & ":F" & no).Interior.ColorIndex = 15

        exsheet.Range("B" & no & ":F" & no).Interior.Pattern = xlSolid

        End If

        no = no + 1

        ProgressBar1.Value = ProgressBar1.Value + 5

    Loop

End With

With exsheet.Range("B3:F" & no - 1)

    .Borders(xlDiagonalUp).LineStyle = xlNone

    .Borders(xlDiagonalDown).LineStyle = xlNone

    

    .Borders(xlEdgeBottom).LineStyle = xlContinuous

    .Borders(xlEdgeBottom).ColorIndex = xlAutomatic

    .Borders(xlEdgeBottom).Weight = xlThick

    

    .Borders(xlEdgeLeft).LineStyle = xlContinuous

    .Borders(xlEdgeLeft).ColorIndex = xlAutomatic

    .Borders(xlEdgeLeft).Weight = xlThick

    

    .Borders(xlEdgeRight).LineStyle = xlContinuous

    .Borders(xlEdgeRight).ColorIndex = xlAutomatic

    .Borders(xlEdgeRight).Weight = xlThick

    

    .Borders(xlInsideVertical).LineStyle = xlContinuous

    .Borders(xlInsideVertical).ColorIndex = xlAutomatic

    .Borders(xlInsideVertical).Weight = xlThin

    

    .Borders(xlInsideHorizontal).LineStyle = xlContinuous

    .Borders(xlInsideHorizontal).ColorIndex = xlAutomatic

    .Borders(xlInsideHorizontal).Weight = xlThin

End With

End If

exsheet.SaveAs ("c:/asal01.xls")

exbook.Close

End Sub

Private Sub Form_Initialize()

Adodc1.Refresh

End Sub

Private Sub Form_Load()

Set exapp = CreateObject("Excel.Application")

Set exbook = exapp.Workbooks

Set exsheet = exbook.Add.Worksheets(1)

ProgressBar1.Value = 0

End Sub