【1】工作表批量另存為獨立的工作簿

Sub 工作表批量另存為獨立的工作簿()

    Dim oWK As Worksheet

    Dim oWB As Workbook

    Dim sPath As String

    Dim sName As String

    If MsgBox('現(xiàn)在開始將把各工作表獨立另存為工作簿文件，請再次檢查格式數(shù)據(jù)是否正確？', vbYesNo, '重要提示') = vbYes Then

        sPath = Excel.ThisWorkbook.Path

        Excel.Application.ScreenUpdating = False

        Excel.Application.DisplayAlerts = False

        For Each oWK In Excel.ThisWorkbook.Worksheets

            With oWK

                    '將工作表名稱作為工作簿的名稱保存

                    sName = .Name

                    .Copy

                    Set oWB = Excel.Application.ActiveWorkbook

                    oWB.SaveAs sPath & '\' & .Name, xlOpenXMLWorkbook

                    oWB.Close

            End With

        Next

        Excel.Application.ScreenUpdating = True

        Excel.Application.DisplayAlerts = True

        MsgBox '操作結(jié)束'

    End If

End Sub

【2】插入圖片批注

Sub 插入圖片批注()

Dim a

a = MsgBox('使用說明：1、請確認您的圖片文件存在與此文件同一目錄下的名稱為pic的文件夾中。2、選中要添加圖片批注的單元格。')

If a = 1 Then

On Error Resume Next

Dim MR As Range

Dim Pics As String

For Each MR In Selection

  If Not IsEmpty(MR) Then

    MR.Select

    MR.AddComment

    MR.Comment.Visible = False

    MR.Comment.Text Text:=''

    MR.Comment.Shape.Fill.UserPicture PictureFile:=ActiveWorkbook.Path & '\pic\' & MR.Value & '.jpg'

End If

Next

End If

End Sub

[3]行列轉(zhuǎn)換