常用代码归集

jsgj2023

Sub 设置打印起止页_份数_是否预览()
    Dim ws As Worksheet
    Set ws = Worksheets(1)
    ws.PrintOut from:=1, to:=10, copies:=3, preview:=False
    Set ws = Nothing
End Sub

jsgj2023

Sub 指定行数和列数换页打印()
    Dim ws As Worksheet
    Dim myRange As Range
    Dim i As Long, j As Long, RowSp As Long, ColSp As Long
    RowSp = 15    '指定要换页的行数
    ColSp = 5    '指定要换页的列数
    Set ws = Worksheets(1)
    With ws
        .Parent.Windows(1).View = xlNormalView
        With .UsedRange
            Set myRange = .Cells(.Cells.Count)
        End With
        .Cells.PageBreak = xlNone
        For i = RowSp + 1 To myRange.Row Step RowSp
            .Rows(i).PageBreak = xlPageBreakManual
        Next
        For i = ColSp + 1 To myRange.Column Step ColSp
            .Columns(i).PageBreak = xlPageBreakManual
        Next
        With .PageSetup
            .CenterHorizontally = True
            .CenterHorizontally = True
        End With
    End With
    Set myRange = Nothing
    Set ws = Nothing
End Sub

jsgj2023

Sub 统计打印总页数()
    Dim ws  As Worksheet
    Set ws = Worksheets(1)
    MsgBox "打印总页数为：" & (ws.VPageBreaks.Count + 1) * (ws.HPageBreaks.Count + 1)
    Set ws = Nothing
End Sub

jsgj2023

Sub 弹出打印机设置框()
    Application.Dialogs(xlDialogPrinterSetup).Show
    MsgBox "您选择了打印机：" & Application.ActivePrinter
End Sub

jsgj2023

Sub 弹出打印窗口()
    Application.Dialogs(xlDialogPrint).Show
End Sub

jsgj2023

Sub 弹出页面设置对话框()
    Application.Dialogs(xlDialogPageSetup).Show
End Sub

jsgj2023

Sub 显示和关闭分页预览()
    MsgBox "下面显示分页预览窗口"
    ActiveWindow.View = xlPageBreakPreview
    MsgBox "下面关闭分页预览窗口"
    ActiveWindow.View = xlNormalView
End Sub

jsgj2023

Sub 自动打印设置()
    Dim wsName() As String
    Dim ws As Worksheet
    Dim i As Long, j As Long
    i = 0
    For j = 1 To Worksheets.Count
        If j Mod 2 = 0 Then
        Else
            i = i + 1
            ReDim Preserve wsName(1 To j)
            wsName(i) = Worksheets(j).Name
        End If
    Next j
    For j = 1 To i
        Worksheets(wsName(j)).PrintOut
    Next j
End Sub

jsgj2023

Sub 是否打印shape对象()
    Dim ws As Worksheet
    Dim myShape As Shape
    Set ws = Worksheets(1)    '制定工作表
    For Each myShape In ws.Shapes
        myShape.ControlFormat.PrintObject = False    '不打印Shape对象
'       myShape.ControlFormat.PrintObject = True     '打印Shape对象
    Next
    Set myShape = Nothing
    Set ws = Nothing
End Sub

jsgj2023

Sub SQL删除指定的数据库()
    On Error GoTo hhh
    Dim cnn As ADODB.Connection
    Dim cnnStr As String, SQL As String
    Dim mydata As String, myTable As String
    mydata = "商品信息"
    Set cnn = New ADODB.Connection
    With cnn
        .ConnectionString = "Provider=SQLOLEDB.1;" _
            & "User ID=sa;" _
            & "Data Source=THTFCOMPUTER"
        .Open
    End With
    SQL = "drop database " & mydata
    cnn.Execute SQL
    MsgBox "数据库删除成功!", vbInformation, "删除数据库"
    GoTo xxx
hhh: MsgBox Err.Description, vbCritical
xxx: cnn.Close
    Set cnn = Nothing
End Sub