1014 從檔案及listbox找出資料並送出列印

Private Sub CommandButton13_Click()
 On Error Resume Next
    Dim sbt As String
 
    sbt = CommandButton13.Caption
    If sbt = "報表4" Then
 
        Set shreport = Worksheets("report")
         
        If shreport Is Nothing Then
            Sheets.Add After:=Sheets(Sheets.Count)   '加在最後面
            Sheets(Sheets.Count).name = "report"
            ActiveWindow.DisplayGridlines = False  '格線取消
         
            '資料輸出從檔案
            Dim con5 As New Ani5
            Dim sql As String
            sql = "select * from scoredata"
            
            Dim kdata
            kdata = con5.dataload(sql, "persondb", "12345678")
         
            Dim listr As Integer
            Dim j As Integer
            listr = UBound(kdata, 1)
            For j = 0 To listr - 1 Step 1
                Cells(j + 1, 1).Value = kdata(j, 0)
                Cells(j + 1, 2).Value = kdata(j, 1)
                Cells(j + 1, 3).Value = kdata(j, 2)
                Cells(j + 1, 4).Value = kdata(j, 3)
                Cells(j + 1, 5).Value = kdata(j, 4)
                Cells(j + 1, 6).Value = kdata(j, 5)
            Next j
            '資料輸出
            UserForm5.Hide
         
            '列印設定
            With ActiveSheet.PageSetup
                .LeftHeader = "&12&""標楷體""北訊電腦資訊中心" '設自型大小 自型 及標題
                .CenterHeader = "成績資料表"
                .RightHeader = "列印日" & "&D"
            End With
         
            With PageSetup
                .LeftFooter = ""
                .CenterFooter = "&p/&n"
                .RightFooter = ""
            End With
         
            Worksheets("report").PrintPreview
            '列印設定
         
            UserForm5.Show vbModeless
         
         
         
        End If
        CommandButton13.Caption = "關閉"
    Else
        'MsgBox "此報表已經存在"
        Application.DisplayAlerts = False
        Sheets("report").Delete
        CommandButton13.Caption = "報表4"
    End If
End Sub
=============================================
Private Sub CommandButton14_Click()
    On Error Resume Next
    Dim sbt As String
 
    sbt = CommandButton14.Caption
    If sbt = "列印輸出" Then
 
        Set shreport = Worksheets("report")
         
        If shreport Is Nothing Then
            Sheets.Add After:=Sheets(Sheets.Count)   '加在最後面
            Sheets(Sheets.Count).name = "report"
            ActiveWindow.DisplayGridlines = False  '格線取消
         
            '資料輸出從listbox
         
            Dim listr As Integer
            Dim j As Integer
            listr = ListBox1.ListCount
            'MsgBox listr
            For j = 0 To listr - 1 Step 1
                Cells(j + 1, 1).Value = ListBox1.List(j, 0)
                Cells(j + 1, 2).Value = ListBox1.List(j, 1)
                Cells(j + 1, 3).Value = ListBox1.List(j, 2)
                Cells(j + 1, 4).Value = ListBox1.List(j, 3)
                Cells(j + 1, 5).Value = ListBox1.List(j, 4)
                Cells(j + 1, 6).Value = ListBox1.List(j, 5)
            Next j
            '資料輸出
            UserForm5.Hide
         
            '列印設定
            With ActiveSheet.PageSetup
                .LeftHeader = "北訊電腦資訊中心"
                .CenterHeader = "成績資料表"
                .RightHeader = "列印日" & "&D"
            End With
         
            With PageSetup
                .LeftFooter = ""
                .CenterFooter = "&p/&n"
                .RightFooter = ""
            End With
         
            Worksheets("report").PrintPreview  '預覽列印
            '列印設定
         
            UserForm5.Show vbModeless
         
         
         
        End If
        CommandButton14.Caption = "關閉"
    Else
        'MsgBox "此報表已經存在"
        Application.DisplayAlerts = False
        Sheets("report").Delete
        CommandButton14.Caption = "列印輸出"
    End If
End Sub
======================
超連結：
1.加入超連結
   Hyperlinks.add  來源資料,目標連結
2.刪除超連結
Hyperlinks.delete
==================================
Private Sub CommandButton1_Click()
    Hyperlinks.Add Cells(1, 1), "http://www.yahoo.com.tw"
End Sub

Private Sub CommandButton2_Click()
    Hyperlinks.Delete
End Sub

Private Sub CommandButton3_Click()
    Dim rcount As Integer
    Dim i As Integer
   
    rcount = UsedRange.Rows.Count
    For i = 1 To rcount Step 1
        Hyperlinks.Add Cells(i, 1), "http://127.0.0.1:80/hope/"
    Next i
   
End Sub

============================

Private Sub CommandButton4_Click()

    Dim cok1 As New Collection

    Dim cok2 As New Collection

    Dim rcount As Integer

    Dim i As Integer

    Dim j As Integer

        

    

    rcount = UsedRange.Rows.Count

    

    For i = 1 To rcount Step 1

        cok1.Add Cells(i, 1)

        cok2.Add Cells(i, 2)

    Next i

    For j = 1 To rcount Step 1

        Hyperlinks.Add Cells(j, 1), "http://127.0.0.1:80/hope/hope01.php?id=" & cok1.Item(j) & "&name=" & cok2.Item(j)

    Next j

End Sub