0

エクセルは苦手なのですが、簡単に説明してみます。どういうわけかタイマーを介してExcelが作成され、シート全体に数百の目に見えないハイパーリンクが広がっています。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
4

2 に答える 2

0

理由も疑問に思っていましたが、このコードが実際に機能する行を読むと、言及されたメモに従うだけで済みます。

'セルの書式設定を削除せずに、選択したセルからハイパーリンクを削除します。

つまり、列 (またはセル) を強調表示/選択して、コードを実行します。

ほら、フォーマットが保持されている間にハイパーリンクが削除されました。

デニス

于 2014-06-24T17:45:34.557 に答える
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

（オリジナル）すべてを手動または自動でコピーできます（ハイパーリンクを含む）。そして、それらを貼り付けた新しいシートで、次を使用してハイパーリンクを削除するだけです。

選択.ハイパーリンク.削除

于 2013-03-19T20:13:24.597 に答える