南部战区雷鸣剑:如何用vb控制excel表格的具体操作

来源:百度文库 编辑:偶看新闻 时间:2024/04/17 03:52:40
如何用vb控制excel表格的具体操作指定链接   
   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    String   
    
   Private    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    Sub   
    
   Private    Sub    Form_Load()   
           Me.Show   
   End    Sub   
    
   Private    Sub    Image2_Click()   
   '打开主页   
   ret&    =    ShellExecute(Me.hwnd,    "Open",    "http://dyqing.533.net",    "",    App.Path,    1)   
    
   End    Sub   
    
   Private    Sub    Image1_Click()   
   '发送邮件   
   ret&    =    ShellExecute(Me.hwnd,    "Open",    "mailto:duyunqing@163.net",    "",    App.Path,    1)   
    
   End    Sub