【问题标题】:Removing hyperlinks, retaining formulas and format删除超链接,保留公式和格式
【发布时间】:2013-03-08 11:05:34
【问题描述】:

我不太擅长 Excel,但我会尝试解释我的问题。不知何故,一个 Excel 是通过计时器创建的,并且不知何故有 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

【问题讨论】:

    标签: excel hyperlink format formula


    【解决方案1】:

    (已编辑)

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

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

        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

    【讨论】:

    • 当使用 selection.hyperlinks.delete 时,它​​会删除单元格的格式(粗体、背景颜色等),这就是为什么这不起作用。
    • 好吧,这个可行,但可能会导致合并单元格或一次占用多个单元格的超链接出现问题。
    【解决方案2】:

    我也想知道为什么,但是在阅读了这段代码实际上有效的代码后,您需要做的就是按照上面提到的注释进行操作:

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

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

    瞧,在保留格式的同时删除了超链接。

    丹尼斯

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 2021-05-12
      • 2014-10-12
      • 2023-04-10
      • 1970-01-01
      • 2023-03-31
      • 2012-02-13
      • 1970-01-01
      • 2013-06-15
      相关资源
      最近更新 更多