'指定链接
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long'Option Explicit
Dim x(1 To 4, 1 To 5) As Integer
Dim a, i, j As Integer
Dim b As StringPrivate Sub Command1_Click()
    Dim ex As Object
    Dim exbook As Object
    Dim exsheet As Object
    Set ex = CreateObject("Excel.Application")
    Set exbook = ex.Workbooks().Add
    Set exsheet = exbook.Worksheets("sheet1")
'按控件的内容赋值
'11
    exsheet.Cells(1, 1).Value = Text1.Text
'为同行的几个格赋值
    Range("C3").Select
    ActiveCell.FormulaR1C1 = "表格"
'    ex.Range("c3").Value = "表 格"
    ex.Range("d3").Value = " 春 天 "
    ex.Range("e3").Value = " 夏 天 "
    ex.Range("f3").Value = " 秋 天 "
    ex.Range("g3").Value = " 冬 天 "
'大片赋值
    ex.Range("c4:g7").Value = x
'按变量赋值
  a = 8
  b = "c" & Trim(Str(a))
  ex.Range(b).Value = "下雪"
'另外一种大片赋值
    For i = 9 To 12
    For j = 4 To 7
    exsheet.Cells(i, j).Value = i * j
    Next j
    Next i
'计算赋值
exsheet.Cells(13, 1).Formula = "=R9C4 + R9C5"
'设置字体
Dim exRange As Object
Set exRange = exsheet.Cells(13, 1)
exRange.Font.Bold = True'设置一行为18号字体加黑
 Rows("3:3").Select
    Selection.Font.Bold = True
    With Selection.Font
        .Name = "宋体"
        .Size = 18
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
'设置斜体
    Range("E2").Select
    Selection.Font.Italic = True
'设置下划线
    Range("E3").Select
    Selection.Font.Underline = xlUnderlineStyleSingle'设置列宽为15
    Selection.ColumnWidth = 15'设置一片数据居中
Range("C4:G7").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
'设置某区域的小数位数
    Range("F4:F7").Select
    Selection.NumberFormatLocal = "0.00"
    
'求和
    Range("G9:G13").Select
    Range("G13").Activate
    ActiveCell.FormulaR1C1 = "=SUM(R[-4]C:R[-1]C)"
'某列自动缩放宽度
    Columns("C:C").EntireColumn.AutoFit
'画表格
    Range("C4:G7").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    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
'加黑框
Range("C9:G13").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
'设置某单元格格式为文本
    Range("E11").Select
    Selection.NumberFormatLocal = "@"
'设置单元格格式为数值
    Range("F10").Select
    Selection.NumberFormatLocal = "0.000_);(0.000)"
'设置单元格格式为时间
    Range("F11").Select
    Selection.NumberFormatLocal = "h:mm AM/PM"'取消选择
Range("C10").Select
'设置横向打印,A4纸张
'    With ActiveSheet.PageSetup
'        .PrintTitleRows = ""
'        .PrintTitleColumns = ""
'    End With
'    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
'        .LeftHeader = ""
'        .CenterHeader = ""
'        .RightHeader = ""
'        .LeftFooter = ""
'        .CenterFooter = ""
'        .RightFooter = ""
'        .LeftMargin = Application.InchesToPoints(0.75)
'        .RightMargin = Application.InchesToPoints(0.75)
'        .TopMargin = Application.InchesToPoints(1)
'        .BottomMargin = Application.InchesToPoints(1)
'        .HeaderMargin = Application.InchesToPoints(0.5)
'        .FooterMargin = Application.InchesToPoints(0.5)
'        .PrintHeadings = False
'        .PrintGridlines = False
'        .PrintComments = xlPrintNoComments
'        .PrintQuality = 300
'        .CenterHorizontally = False
'        .CenterVertically = False
        .Orientation = xlLandscape
'        .Draft = False
        .PaperSize = xlPaperA4
'        .FirstPageNumber = xlAutomatic
'        .Order = xlDownThenOver
'        .BlackAndWhite = False
'        .Zoom = 100
    End With
'跨列居中
    Range("A1:G1").Select
    With Selection
        .HorizontalAlignment = xlCenter
'        .VerticalAlignment = xlBottom
'        .WrapText = False
'        .Orientation = 0
'        .AddIndent = False
'        .ShrinkToFit = False
        .MergeCells = True
    End With
    Selection.Merge'打印表格
ActiveWindow.SelectedSheets.PrintOut Copies:=1'取值
Text1.Text = exsheet.Cells(13, 1)
'保存
ChDir "C:\WINDOWS\Desktop"
ActiveWorkbook.SaveAs FileName:="C:\WINDOWS\Desktop\aaa.xls", FileFormat:=xlNormal, Password:="123", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
   ' 关闭工作表。
   exbook.Close
   '用 Quit 方法关闭 Microsoft Excel
   ex.Quit
   '释放对象
   Set ex = Nothing
   Set exbook = Nothing
   Set exsheet = Nothing
Dim retval
'用excel打开表格
retval = Shell("C:\Program Files\Microsoft Office\Office\EXCEL.EXE" & " " & "C:\WINDOWS\Desktop\aaa.xls", 1)
   End SubPrivate Sub Form_Load()
    Me.Show
End SubPrivate Sub Image2_Click()
'打开主页
ret& = ShellExecute(Me.hwnd, "Open", "http://dyqing.533.net", "", App.Path, 1)End SubPrivate Sub Image1_Click()
'发送邮件
ret& = ShellExecute(Me.hwnd, "Open", "mailto:[email protected]", "", App.Path, 1)End Sub