excel学习库

Private Sub 深度隐藏工作表按钮_Click(sender As Object, e As RibbonControlEventArgs) Handles 深度隐藏工作表按钮.Click        app.ActiveSheet.viseble = 2        MsgBox("隐藏成功！")    End sub

    Private Sub 备份工作簿按钮_Click(sender As Object, e As RibbonControlEventArgs) Handles 备份工作簿按钮.Click        app.ActiveWorkbook.SaveAs(app.ActiveWorkbook.Path & "\" & app.ActiveWorkbook.Name & "-备份" & Format(Now, "yyyy-mm-dd -HH-MM-SS") & ".xls")        MsgBox("备份成功，备份在原工作簿文件夹下")    End Sub    

    Private Sub 提取工作簿批注按钮_Click(sender As Object, e As RibbonControlEventArgs) Handles 提取工作簿批注按钮.Click        Dim sht As Excel.Worksheet        Dim pz As Excel.Comment        Dim arr(), brr()        Dim i& = 0        For Each sht In app.ActiveWorkbook.Worksheets            For Each pz In sht.Comments                ReDim Preserve arr(0 To i)      '保留原有数据，重新定义数组下标                ReDim Preserve brr(0 To i)      '保留原有数据，重新定义数组下标                brr(i) = sht.Name               '提取工作表                arr(i) = pz.Text                '提取批注                i += 1            Next        Next
        Dim 开始输出单元格 As Excel.Range = app.InputBox("请选择开始输出单元格", Type:=8)        开始输出单元格.Resize(UBound(brr) + 1, 1).Value = app.WorksheetFunction.Transpose(brr)        开始输出单元格.Offset(0, 1).Resize(UBound(arr) + 1, 1).Value = app.WorksheetFunction.Transpose(arr)    End Sub

    Private Sub 提取有效性表达式按钮_Click(sender As Object, e As RibbonControlEventArgs) Handles 提取有效性表达式按钮.Click        On Error GoTo line1                                           '错误跳转，没有设置的时候判断就会出现错误----此时跳转到 line1        Dim myrange As Excel.Range        Dim 输出 As Excel.Range = app.InputBox("请选择输出单元格", "提示", Type:=8)        Dim arr()       '定义一维数组        Dim brr(,)       '定义一维数组
        myrange = app.InputBox("请选择有效性单元格", "提示", , , , , , 8)
        If myrange.Validation.Type >= 0 Then                                  '不存在有效性时，使用myrange会报错，跳转结束            输出.Value = myrange.Validation.Formula1   '获取到有效性序列的表达式，如果是选择单元格表达式$A$1:$A$10，则需要再加工        End If
line1:  MsgBox("该单元格没有设置有效性，无数据可提取！", vbCritical, "提取有效性序列") : Exit Sub    End Sub

    Private Sub 单元格内容导入批注按钮_Click(sender As Object, e As RibbonControlEventArgs) Handles 单元格内容导入批注按钮.Click        On Error Resume Next        Dim rng As Excel.Range = app.InputBox("请选择导入区域", Type:=8)        For Each rg As Excel.Range In rng            With rg                If MsgBox("是否追加写入？", MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then                    Dim pz As String = rg.Comment.Text                          '提取批注                    .ClearComments()                                            '删除批注                    .AddComment.Text(pz & Chr(10) & rg.Value)      '把内容导入批注                Else                    .ClearComments()                       '删除批注                    .AddComment.Text(rg.Value)      '把内容导入批注                End If
            End With        Next        MsgBox("导入完成！")    End Sub