dポイントプレゼントキャンペーン実施中!

いつもお世話になっております。
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
"メールアドレス"範囲を別の所にコピーしておき、値だけ削除して元に戻して・・・なども考えてみましたが・・・?←これは、余計かも?
宜しくお願い致します。

A 回答 (3件)

こんにちは。



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

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

ただ、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
    • good
    • 0

こんにちは


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

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


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

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

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

こんばんは。



コードとしては、よく分からないし、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
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!