注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

闻新而动

双核动力

 
 
 

日志

 
 
 
 

如何用vb控制excel表格的具体操作  

2010-07-16 14:17:54|  分类: 网捞快文 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

'指定链接   
   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   

  评论这张
 
阅读(507)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017