Excel_VBAでハイパーリンクの削除時の書式

質問

いつもお世話になっております。
ExcelのVBAで、ハイパーリンクを削除すると、一緒に書式もクリアーされてしまいます。
罫線と、背景色を残す方法ってあるのでしょうか？
一応、背景色だけ保存しておいて、後で、復帰させようと考えましたが、罫線も一時待避させるとなると、ちょっと大げさになるので、何か？知恵をお借り出来ないでしょうか？
Private Sub CommandButton11_Click()
'リンク解除
Dim MyColor As Integer
MyColor = maillist.Range("メールアドレス").Range"A1").Interior.ColorIndex
maillist.Range("メールアドレス").Hyperlinks.Delete
maillist.Range("メールアドレス").Interior.ColorIndex = MyColor
End Sub
"メールアドレス"範囲を別の所にコピーしておき、値だけ削除して元に戻して・・・なども考えてみましたが・・・？←これは、余計かも？
宜しくお願い致します。

回答No.2

KenKen_SP · ベストアンサー

こんにちは。

> "メールアドレス"範囲を別の所にコピーしておき、値だけ削除して元に
> 戻して・・・

仕様から見れば、元に戻すのは書式の方が都合が良いでしょう。

ただ、PasteSpecial で書式を戻すとしても複数のセルブロックが選択された
状態が想定できますから、PasteSpecial をエラーなく実行するためには、
Areas プロパティーで選択ブロック毎の処理になると思います。完全に一括で
はありませんが、止むを得ないかと...

' // 書式を残したままハイパーリンクを一括削除
Sub DeleteHyperLinks()

　　If Not TypeOf Selection Is Range Then Exit Sub
　　If Selection.Hyperlinks.Count = 0 Then Exit Sub

　　Dim wb　　　　　　　As Workbook
　　Dim sh　　　　　　　As Worksheet
　　Dim rTarget　　　　 As Range
　　Dim r　　　　　　　 As Range

　　Application.ScreenUpdating = False

　　Set rTarget = Selection
　　Set wb = Workbooks.Add
　　Set sh = wb.Worksheets(1)

　　For Each r In rTarget.Areas
　　　　If r.Hyperlinks.Count > 0 Then
　　　　　　r.Copy Destination:=sh.Cells(1)
　　　　　　r.Hyperlinks.Delete
　　　　　　With sh.Cells(1).Resize(r.Rows.Count, r.Columns.Count)
　　　　　　　　.Copy
　　　　　　　　r.PasteSpecial xlPasteFormats
　　　　　　　　.Clear
　　　　　　End With
　　　　End If
　　Next

　　Set rTarget = Nothing
　　Set sh = Nothing
　　wb.Close SaveChanges:=False
　　Set wb = Nothing

End Sub

回答No.3

cj_mover

こんにちは
こんな感じのことだと思うのですが・・・

Dim vntB
　With Range("メールアドレス")
vntB = .Formula
.ClearContents
.Formula = vntB
'.Font.ColorIndex = xlColorIndexAutomatic
'.Font.Underline = xlUnderlineStyleNone
　End With

　Range("メールアドレス") が矩形範囲であることが条件です。
（それ以外なら、ループにして下さい。）

　コメントにした部分は、どうしたいか判らないので仮にしていますが、
このままだと、見た目上、リンクが残っているみたいになるので、
何かしら工夫して下さい。
（書式を）いじらない方向で書いても、結局いじる必要があるみたいですね。

　わりと攻め込んだコードです。バックアップをお願いします。

回答No.1

Wendy02

こんばんは。

コードとしては、よく分からないし、maillist って、シート名だとしたら、CommandButton とは、違うシートでしょうか？

maillist.Hyperlinks.Delete

このように一括でするとなると、それを、一旦、Range をどこかに確保しなければならないから、結果的には、最初は一括でしても、後が、一括では出来そうな気がしません。

ひとつずつ、以下のようなコードにすればよいと思います。
Hyperlinkから、ただの、Range への切り替えをします。ただ、以前のバージョン(2000)は、Hyperlinkオブジェクトを削除しても色が残った気がします。今は、色と下線は、仮にオブジェクトのRangeにつけても、Hyperlink の削除とともに消えるようですね。

Sub Test1()
　　Dim v As Variant
　　Dim r As Range
　　For Each v In ActiveSheet.Hyperlinks
　　　　Set r = v.Range
　　　　v.Delete
　　　　r.Font.Underline = xlUnderlineStyleSingle
　　　　r.Font.ColorIndex = 5
　　Next v
　　Set r = Nothing
End Sub