删除超链接,保留公式和格式

时间:2013-03-19 16:31:22

标签: excel hyperlink format formula

我对Excel不太满意,但我会尝试解释我的问题。不知何故,excel是通过Timer创建的,并且不知何故有100个不可见的超链接遍布整个工作表。我试图找到一种从A1复制的方法:k50删除所有超链接但保留公式,值和格式。我在网上发现了这个代码,我尝试添加HR.PasteSpecial xlPasteFormulas,但这似乎不起作用。任何想法/想法将不胜感激。

 Sub RemoveHlinks()
'Remove hyperlinks from selected cells without
'removing the cell formatting.
Dim Hlink      As Hyperlink
Dim HR         As Range
Dim Temp       As Range
Dim MaxCol     As Integer

With ActiveSheet.UsedRange
   MaxCol = .Column + .Columns.Count
End With

Set Temp = Cells(1, MaxCol)

For Each Hlink In Selection.Hyperlinks
 Set HR = Hlink.Range
 HR.Copy Destination:=Temp
 HR.ClearContents
 Set Temp = Temp.Resize(HR.Rows.Count, HR.Columns.Count)
 Temp.Copy
 HR.PasteSpecial xlPasteFormats
 HR.PasteSpecial xlPasteValues
 Temp.Clear
Next Hlink

End Sub

2 个答案:

答案 0 :(得分:0)

(编辑)的

我相信你必须复制每个单元格中的每个属性(希望没有合并的单元格,这会导致额外的麻烦),然后删除它的超链接,然后恢复属性。

您可以录制宏来发现所有属性,这里有一些字体和内部示例。要发现您可能需要执行的其他属性,您必须开始录制宏,选择一些单元格,手动更改属性,停止录制,并在生成的代码中查看属性是什么。

    Sub Macro1()
    '
    ' Macro1 Macro
    '


        Dim Cell As Range
        Dim SelectedRange As Range

        Set SelectedRange = ActiveSheet.Range("A1:K50")

        Dim Rows As Integer
        Dim Columns As Integer
        Dim i As Integer
        Dim j As Integer


        Rows = SelectedRange.Rows.Count
        Columns = SelectedRange.Columns.Count

        For i = 1 To Rows
            For j = 1 To Columns
                Set Cell = SelectedRange.Cells(i, j)
                Call ClearHyperlinks(Cell)
            Next
        Next

    End Sub


    Sub ClearHyperlinks(Cell As Range)
        '''''''''' Font Properties''''''''''''''

        Dim fName As Variant
        Dim fFontStyle As Variant
        Dim fSize As Variant
        Dim fStrikethrough As Variant
        Dim fSuperscript As Variant
        Dim fSubscript As Variant
        Dim fOutlineFont As Variant
        Dim fShadow As Variant
        Dim fUnderline As Variant
        Dim fThemeColor As Variant
        Dim fTintAndShade As Variant
        Dim fThemeFont As Variant

        With Cell.Font
            fName = .Name
            fFontStyle = .FontStyle
            fSize = .Size
            fStrikethrough = .Strikethrough
            fSuperscript = .Superscript
            fSubscript = .Subscript
            fOutlineFont = .OutlineFont
            fShadow = .Shadow
            fUnderline = .Underline
            fThemeColor = .ThemeColor
            fTintAndShade = .TintAndShade
            fThemeFont = .ThemeFont
        End With



        ''''''''''Interior Properties''''''''''''''

        Dim iPattern As Variant
        Dim iPatternColorIndex As Variant
        Dim iThemeColor As Variant
        Dim iTintAndShade As Variant
        Dim iPatternTintAndShade As Variant

        With Cell.Interior
            iPattern = .Pattern
            iPatternColorIndex = .PatternColorIndex
            iThemeColor = .ThemeColor
            iTintAndShade = .TintAndShade
            iPatternTintAndShade = .PatternTintAndShade
        End With


        ''''''''''''' Number Format '''''''''
        Dim NumberFormat As Variant
        NumberFormat = Cell.NumberFormat

        '''''''''''''' Delete Hyeperlinks
        Cell.Hyperlinks.Delete



        ''''''''''''''''''Restore properties'''''''''''''''

        Cell.NumberFormat = NumberFormat


        With Cell.Font
            .Name = fName
            .FontStyle = fFontStyle
            .Size = fSize
            .Strikethrough = fStrikethrough
            .Superscript = fSuperscript
            .Subscript = fSubscript
            .OutlineFont = fOutlineFont
            .Shadow = fShadow
            .Underline = fUnderline
            .ThemeColor = fThemeColor
            .TintAndShade = fTintAndShade
            .ThemeFont = fThemeFont
        End With

        With Cell.Interior
            .Pattern = iPattern
            .PatternColorIndex = iPatternColorIndex
            .ThemeColor = iThemeColor
            .TintAndShade = iTintAndShade
            .PatternTintAndShade = iPatternTintAndShade
        End With


    End Sub

(原) 您可以手动或自动复制所有内容(包括超链接)。 在粘贴这些内容的新工作表中,只需使用以下命令删除超链接:

Selection.Hyperlinks.Delete

答案 1 :(得分:0)

我也想知道为什么,但通过阅读这些代码确实有效,您需要做的就是按照提到的注释:

'删除选定的单元格中的超链接 '删除单元格格式。

即。突出显示/选择列(或单元格)并运行代码

Voila,在格式保留的情况下删除了超链接。

丹尼斯