yhd-VBA转VB.Net VSTO学习记录-2
【学*研*行】
每天学习一点，进步一点
【目标】
想搞个插件
【目录】
文件类 | 读取一个文件读取多个文件 |
|---|---|
工作表类 | 列出工作表名称 |
单元格类 | 修改单元格颜色读取区域A1:C3当前打印九九乘法表清空当前工作表内容 |
【代码】
【放上代码，方便复制、粘贴】
代码语言：javascript复制 '读取一个文件
Private Sub Button2_Click(sender As Object, e As RibbonControlEventArgs) Handles Button2.Click
Dim yhdfile As String '= "C:UsersAdminDesktoptest拆分源test.xlsx"
With OpenFileDialog1
.Filter = "Excel文件|*.xls*"
.Multiselect = False
If .ShowDialog() = DialogResult.OK Then
If System.IO.File.Exists(.FileName) Then
MsgBox(.FileName vbCrLf "文件存在", Title:="哆哆提示")
yhdfile = .FileName
xlapp.ActiveCell.Value = yhdfile
End If
Else
Exit Sub
End If
End With
yhdfile = xlapp.ActiveCell.Value
'xlapp.Workbooks.Open(yhdfile)
End Sub
'读取多个文件
Private Sub Button7_Click(sender As Object, e As RibbonControlEventArgs) Handles Button7.Click
With OpenFileDialog1
.Filter = "Excel文件|*.xls*"
.Multiselect = True
If .ShowDialog <> Windows.Forms.DialogResult.Cancel Then
Dim i As Integer
For Each filename As String In .FileNames
xlapp.ActiveCell.Offset(i, 0).Value = filename
i = i 1
Next
Else
Exit Sub
End If
End With
End Sub
'新建工作表
Private Sub Button3_Click(sender As Object, e As RibbonControlEventArgs) Handles Button3.Click
For Each s As Excel.Worksheet In xlapp.Worksheets
If s.Name = "dd1" Or s.Name = "dd2" Or s.Name = "dd3" Then
MsgBox(s.Name "存在")
s.Delete()
End If
Next
'三种方法创建工作表
Globals.ThisAddIn.Application.Worksheets.Add.name = "dd1"
xlapp.Worksheets.Add.name = "dd2"
With xlapp.Worksheets("dd2")
.cells(1, 1) = "哆哆新建工作表dd2"
End With
Dim yhdsht As Excel.Worksheet
yhdsht = xlapp.Worksheets.Add()
yhdsht.Name = "dd3"
End Sub
'复制工作表
Private Sub Button4_Click(sender As Object, e As RibbonControlEventArgs) Handles Button4.Click
Dim Acsht As Excel.Worksheet = xlapp.ActiveSheet
Dim Tosht As Excel.Worksheet
Acsht.Copy(After:=xlapp.Worksheets(xlapp.Worksheets.Count))
Dim shtname As String = "dd" xlapp.Worksheets.Count.ToString()
xlapp.Worksheets(xlapp.Worksheets.Count).Name = shtname
Tosht = xlapp.Worksheets(xlapp.Worksheets.Count)
MsgBox("工作表名：" Tosht.Name)
Tosht.Name = "修改dd" xlapp.Worksheets.Count.ToString()
End Sub
'列出所有工作表名称
Private Sub Button5_Click(sender As Object, e As RibbonControlEventArgs) Handles Button5.Click
Dim sh As Excel.Worksheet
Dim nm As Int32
For Each sh In xlapp.Worksheets
xlapp.ActiveCell.Offset(nm, 0).Value = sh.Name
nm = nm 1
Next
End Sub
'修改单元格的颜色，颜色值是0-56之间
Private Sub Button6_Click(sender As Object, e As RibbonControlEventArgs) Handles Button6.Click
Dim color As Int16 = xlapp.WorksheetFunction.RandBetween(0, 56)
xlapp.ActiveCell.Interior.ColorIndex = color
xlapp.ActiveCell.Offset(0, 1).Value = "颜色值：" color.ToString()
End Sub
'先加颜色，再加边框，再转化为文本格式，若A1:C3全为空,退出，否则读取并输出
Private Sub Button8_Click(sender As Object, e As RibbonControlEventArgs) Handles Button8.Click
'Dim star_arr(,) As Integer = {{1, 2, 3}, {4, 5, 6}}
'xlapp.ActiveSheet.Cells(1, 1).Resize(2, 3).value = star_arr
Dim A1C3 As Excel.Range = xlapp.ActiveSheet.Range("A1:C3")
With A1C3
.Borders.LineStyle = 1
.Interior.Color = 65535
.NumberFormatLocal = "@"
End With
MsgBox("单元格总数：" A1C3.Count.ToString())
If xlapp.WorksheetFunction.CountA(A1C3) <> 0 Then
Dim Read_arr As Array = xlapp.ActiveSheet.Range("A1:C3").value
MsgBox("行：" UBound(Read_arr, 1).ToString() "列：" UBound(Read_arr, 2).ToString())
For i As Integer = LBound(Read_arr, 1) To UBound(Read_arr, 1)
For j As Integer = LBound(Read_arr, 2) To UBound(Read_arr, 2)
MsgBox(Read_arr(i, j))
Next
Next
Else
MsgBox("A1:C3全为空，将要退出")
Exit Sub
End If
End Sub
'当前打印九九乘法表
Private Sub Button9_Click(sender As Object, e As RibbonControlEventArgs) Handles Button9.Click
For i As Integer = 1 To 9
For j As Integer = 1 To 9
If j <= i Then
xlapp.ActiveCell.Offset(i - 1, j - 1).Value = i.ToString() "*" j.ToString() "=" (i * j).ToString()
Else
Exit For
End If
Next
Next
End Sub
'清空当前工作表内容
Private Sub Button10_Click(sender As Object, e As RibbonControlEventArgs) Handles Button10.Click
xlapp.ActiveSheet.cells.clear()
End Sub
