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
沒有留言:
張貼留言