.Hyperlinks.Add的应用

ning84 · 发表于 2024-7-15 07:30

参数

名称	必选/可选	数据类型	描述
Anchor	必选	Object	超链接的位置。可为 Range 或 Shape 对象。
Address	必选	String	超链接的地址。
SubAddress	可选	Variant	超链接的子地址。
ScreenTip	可选	Variant	当鼠标指针停留在超链接上时所显示的屏幕提示。
TextToDisplay	可选	Variant	要显示的超链接的文本。

Visual Basic for Applications

With Worksheets(1) .Hyperlinks.Add Anchor:=.Range("a5"), _ Address:="http://example.microsoft.com", _ ScreenTip:="Microsoft Web Site", _ TextToDisplay:="Microsoft"End With

*****************************************************************

Sub ll()
Dim Fso As FileSystemObject
Set Fso = New FileSystemObject
Dim oFolder As Folder, oFile As File
Dim oFolder1 As Folder, oFolder2 As Folder, oFolder3 As Folder
Dim Sht As Worksheet
Dim Str, oStr, oPath
Dim Rng As Range, oRng As Range, oRng1 As Range
Set Rng = Selection
Set Sht = Rng.Parent
With Sht
Set Rng = .Range(.Cells(4, 1).Formula)
End With
Set Rng = Rng(3, 1).Resize(Rng.Rows.Count - 2, Rng.Columns.Count)
Debug.Print Rng.Address
Rng.Select
Dim RootName
RootName = Sht.Cells(1, 1)
Debug.Print Rng.Address
For jj = 3 To 1 Step -1
For ii = 1 To Rng.Rows.Count
Set oRng = Rng(ii, jj)
oRng.Select
If oRng.MergeCells Then 'MergeArea.Count > 1 Then
Set oRng = oRng.MergeArea
ii = ii + oRng.Count
End If
Debug.Print oRng(, "H").Address, oRng(, "H")
oPath = Sht.Cells(oRng.Row, "H")
Debug.Print oPath
Set oFile = Fso.GetFile(oPath)
Set oFolder3 = oFile.ParentFolder
Set oFolder2 = oFolder3.ParentFolder
Set oFolder1 = oFolder2.ParentFolder
''
Select Case jj
Case 1
oStr = Format(oRng(, "D"), "yyyy年")
Set oFolder1 = oFolder2.ParentFolder
''
Sht.Hyperlinks.Add Anchor:=Selection, Address:=oFolder1.Path, TextToDisplay:=oStr
Case 2
oStr = Format(Sht.Cells(oRng.Row, "D"), "yyyy年mm月")
''
Sht.Hyperlinks.Add Anchor:=Selection, Address:=oFolder2.Path, TextToDisplay:=oStr
Case 3
oStr = Format(Sht.Cells(oRng.Row, "D"), "yyyy年mm月dd日")
''
Sht.Hyperlinks.Add Anchor:=Selection, Address:=oFolder3.Path, TextToDisplay:=oStr
End Select
Next ii
Next jj
Stop
End Sub

复制代码

ning84 · 发表于 2024-7-30 06:54

Sub ddd()
Dim Rng As Range
Set Rng = Selection
With Rng
.Merge
.VerticalAlignment = xlTop
.HorizontalAlignment = xlLeft
End With
End Sub

复制代码

ning84 · 发表于 2024-7-31 07:56

Sub llll()
Dim Rng As Range
Set Rng = Selection
Debug.Print Rng.Address
Stop
Dim oRng As Range
Set oRng = Rng(, 0).MergeArea
Debug.Print oRng.Address
Stop
End Sub

复制代码

'''

Function MergeRng(Rng As Range)
Dim LastRow, FirstRow
Dim ii, jj
Dim oRng As Range
Dim Sht As Worksheet
Set Sht = Rng.Parent
With Rng.Parent
LastRow = Rng.Row + Rng.Rows.Count - 1
For ii = Rng.Row + Rng.Rows.Count - 1 To 2 Step -1
If .Cells(ii, Rng.Column).Value <> .Cells(ii - 1, Rng.Column).Value Then
FirstRow = ii
If FirstRow < Rng.Row Then
Exit Function
End If
.Cells(FirstRow, Rng.Column).Resize(LastRow - FirstRow + 1, 1).Merge
LastRow = ii - 1
End If
Next ii
Set oRng = Rng.MergeArea
End With
End Function
''
Function MergeRetuFolderFile(Fso As FileSystemObject, Rng As Range)
Dim Sht As Worksheet
Set Sht = Rng.Parent
Dim oFile As File
Dim oFolder1 As Folder, oFolder2 As Folder, oFolder3 As Folder
Dim oSize
Dim oStr
Dim oRng As Range, oRng1 As Range
For jj = 1 To 3
For ii = 1 To Rng.Rows.Count
Set oRng = Rng(ii, jj)
If oRng.MergeCells Then
Set oRng = oRng.MergeArea
With oRng
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
End With
oRng.Select
'Debug.Print oRng.Address, oRng(1, 1).Address, oRng(, "H")
With Sht
oStr = .Cells(oRng(, 1).Row, "H")
End With
Set oFile = Fso.GetFile(oStr)
Set oFolder3 = oFile.ParentFolder
Set oFolder2 = oFolder3.ParentFolder
Set oFolder1 = oFolder2.ParentFolder
Select Case jj
Case 1
Set oRng1 = Sht.Cells(oRng(, 1).Row, "F").Resize(oRng.Rows.Count, 1)
oSize = WorksheetFunction.Sum(oRng1)
oStr = oFolder1.Name & Chr(10) & "SubFolder" & oFolder1.SubFolders.Count & Chr(10) & "Files:" & oRng.Rows.Count & Chr(10) & "Size:" & oSize & "MB"
Sht.Hyperlinks.Add Anchor:=Selection, Address:=oFolder1.Path, TextToDisplay:=oStr
Case 2
Set oRng1 = Sht.Cells(oRng(, 1).Row, "F").Resize(oRng.Rows.Count, 1)
oSize = WorksheetFunction.Sum(oRng1)
oStr = oFolder2.Name & Chr(10) & "SubFolder" & oFolder2.SubFolders.Count & Chr(10) & "Files:" & oRng.Rows.Count & Chr(10) & "Size:" & oSize & "MB"
Sht.Hyperlinks.Add Anchor:=Selection, Address:=oFolder2.Path, TextToDisplay:=oStr
Case 3
Set oRng1 = Sht.Cells(oRng(, 1).Row, "F").Resize(oRng.Rows.Count, 1)
oSize = WorksheetFunction.Sum(oRng1)
oStr = oFolder3.Name & Chr(10) & "Files:" & oRng.Rows.Count & Chr(10) & "Size:" & oSize & "MB"
Sht.Hyperlinks.Add Anchor:=Selection, Address:=oFolder3.Path, TextToDisplay:=oStr
End Select
oRng(, 1) = oStr
'Debug.Print oFolder1.Path, oFolder2.Path, oFolder3.Path
ii = ii + oRng.Rows.Count
End If
Next ii
Next jj
End Function

复制代码

		自动登录	找回密码
密码			免费注册