VB应用研究

最新推荐文章于 2020-10-30 17:14:04 发布

davin_007

最新推荐文章于 2020-10-30 17:14:04 发布

阅读量512

点赞数

分类专栏：技术文章文章标签： vb windows each c

本文链接：https://blog.csdn.net/davin_007/article/details/1719845

版权

技术文章专栏收录该内容

21 篇文章 0 订阅

订阅专栏

Sub nn()
Application.WindowState = xlMinimized
   For Each c In Worksheets("aa").Range("A1:A3")
Windows("bb.xls").Activate
Sheets("dd").Select
   'Call ss(c)
   'Call mm(c)
   Next c
Application.WindowState = xlMaximized
End Sub

Sub mm(ByVal target As Range)
For Each wks In ThisWorkbook.Worksheets
    If wks.Name = target Then
      target.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
      target.Hyperlinks.Delete
        Application.DisplayAlerts = False
        ActiveWindow.SelectedSheets.Delete
        Application.DisplayAlerts = True

    End If
Next
End Sub

Sub ss(ByVal target As Range)
target.Select
ActiveCell.FormulaR1C1 = target
Windows("dd.xls").Activate

Rows("1:1").Select
Selection.Insert Shift:=xlDown
Columns("A:A").ColumnWidth = 22.38
Range("A1").Select

ActiveCell.FormulaR1C1 = target
Workbooks.Add
Sheets("Sheet1").Select
Sheets("Sheet1").Name = target

ActiveWorkbook.SaveAs Filename:= _
       "E:/aa/" & target & ".xls", _
       FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
Windows("cc.xls").Activate
target.Select

Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True

Application.CutCopyMode = False
Cells.Select

Selection.Copy
Windows(target & ".xls").Activate

Cells.Select
ActiveSheet.Paste
Windows("dd.xls").Activate

Range("A1").Select
Application.CutCopyMode = False
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=target & ".xls" _
        , SubAddress:="'" & target & "'!A1"

Windows(target & ".xls").Activate
ActiveWorkbook.Save
ActiveWindow.Close
End Sub