南部战区雷鸣剑:如何用vb控制excel表格的具体操作
来源:百度文库 编辑:偶看新闻 时间:2024/04/30 01:37:09
如何用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
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
EXCEL表格如何用函数控制字的颜色?
如何用EXCEL复制表格
如何用EXCEL复制表格
如何用excel编辑表格
如何用javascript控制表格?
如何用vb调用excel?
如何用Excel制作可以查询的表格
高手请进 如何用 EXCEL制作 评委评分的表格
如何用EXCEL表格计算内部收益率
如何用excel制作进销存表格
如何用VB读取Excel的单元格的批注
如何用VBA/VB来设置Excel的格式
如何用VFP控制EXCEL的筛选问题?
如何用vb控制交换机呼出限制?
如何用VB控制首字符延迟时间?
如何用vb控制视频捕捉卡
在EXCEL表格中两列数字,如何用函数形式找出相同的数字?
■救命■如何用Excel做一个只有2行的表格?
高手请进 如何用 EXCEL制作 关于比赛积分的表格
如何用EXCEL制作一个可以快速查看到产品资料和库存的表格
请问如何用EXCEL中的“宏”制作表格??????
我已下载excel,如何用他做表格?
如何用excel表格统计单数双数问题?
如何用Excel为表格加1.5磅单实线