マンガでよめる痔のこと・薬のこと

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

このQ&Aに関連する最新のQ&A

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に関連する人気のQ&A

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

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QEXCELでハイパーリンクの解除を行うと書式設定が失われる

ハイパーリンクの解除をおこなうと、セルの書式設定が解除されてしまいます。
ハイパーリンクとして必要なところと、必要ないところ(単に記号的な使い方をしています)と分けているため、設定でハイパーリンクを無効にすると不便になってしまいます
何か対処法はありますでしょうか?

OSはMEでExcel2000にSR-1をあてています。

Aベストアンサー

回答がありませんね。

ハイパーリンクを設定したセルに対し、ハイパーリンク→ハイパーリンクの削除を行うと『セルの書式が解除されるのをどうにかしたい』ということで考えてみました。
ただ、『必要なところと、必要ないところ(単に記号的な使い方をしています)と分けているため』については、意味を理解できていません。見当違いの回答かもしれませんが、その場合はご容赦を。

通常方法では思いつきませんので、ハイパーリンクのみを解除するマクロを書いてみました。(Excel2000)

マクロでハイパーリンクを削除しても、セルの書式は初期化されてしまうみたいです。
『Style スタイル』でどうにかなるかと思いましたが、余り芳しくありませんでした。
また、セルの書式を配列に全部覚えておければ簡単ですが、コーディングが大変みたいでした。
コントロールのPropertiesコレクションのようなものがあれば楽ですが、Excelのセルに対してはないみたいです。
結局、セルの値または式を退避しておき、ハイパーリンクごと消去し、値または式を復元する事にしました。
アンダーラインについては、これがハイパーリンクのものか、意図的に引いたものか、または消してある場合もあるので、マクロを実行する時点のまま変更していません。

マクロ内部でエラー処理を行っていますが、これは結合セルがあると消去が普通にできないからです。
実際使ってみて、マクロをショートカットキーに登録しておけば便利かもしれません。

列全体、全シートを処理すると時間がかかります。ご注意を。(EscまたはCtrl+Breakで止まります)


ここから

Sub del_HyperLink()
  Dim rg As Range 'セル
  Dim rgVal 'マクロ操作前のセルの値
  Dim rgULine 'マクロ操作前のアンダーラインの招待

  On Error GoTo ErrorHandler 'エラー対応

  For Each rg In Selection
    rgULine = rg.Font.Underline 'アンダーライン
    'セルの内容が値か、または式か
    If Not rg.HasFormula Then
      rgVal = rg.Text
    Else
      rgVal = rg.Formula
    End If

    rg.ClearContents '消去
    rg.Font.Underline = rgULine 'アンダーラインを戻す
    rg = rgVal '値または式を戻す
  Next
  Exit Sub

ErrorHandler:
  '結合セルを操作しに行った時の対応
  If Err.Number = 1004 Then
    Resume Next
  End If
End Sub

回答がありませんね。

ハイパーリンクを設定したセルに対し、ハイパーリンク→ハイパーリンクの削除を行うと『セルの書式が解除されるのをどうにかしたい』ということで考えてみました。
ただ、『必要なところと、必要ないところ(単に記号的な使い方をしています)と分けているため』については、意味を理解できていません。見当違いの回答かもしれませんが、その場合はご容赦を。

通常方法では思いつきませんので、ハイパーリンクのみを解除するマクロを書いてみました。(Excel2000)

マクロでハイパーリ...続きを読む

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

QEXCEL2000VBAでハイパーリンクの有無を調べたい。

おはつです。どなたか、知ってらっしゃる方がいらしゃいましたら、よろしくお願い致します。
[環境]
Windows2000
EXCEL2000

[質問]
・下記のソースで、ハイパーリンクが設定されている項目
をcmdボタンイベントから設定を外しました。しかし、ハイ
パーリンクが元データに設定されていない場合、Errが返り
ます。
selectで指定されたセルのハイパーリンク有無を調べる
方法を教えて頂けないでしょうか?

If Not IsNull(Trim(Range("E105").Text)) Or Trim(Range("E105").Text) <> "" Then
sURL1 = Trim(Range("E105").Text)
Range("E105:AG108").Select
Selection.Hyperlinks(1).Delete
End If

Aベストアンサー

selection.hyperlinks.count
でリンクの数を取得すればよいかと。

Qエクセル VBA ユーザーフォームを閉じる

ユーザーフォームを開く時は
UserForm1.Showですが
閉じる時は?
UserForm1.Close
だとコンパイルエラーになります。
End
にするしかないですか?

Aベストアンサー

Unload Me とか Unload UserForm1 でユーザーフォームを閉じることができます。

QEXCEL(VBA) セルをクリックしたときの処理

何度もお世話になります。

A5:A20のどれかをクリックしたときに
クリックしたセルが値が入力済みか確認してから
ファイルを名前を付けて保存したいのですが
クリックしたという情報(イベント?)の取得方法が
わかりません。

(1)どのようにチェックすればよいのでしょうか?
(2)また、皆さんはどのようにしてこのような問題を解決してるのでしょうか?

よろしくお願いします。

Aベストアンサー

Sheet1だとして、
Sheet1のマクロで

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
If Target.Column = 1 And Target.Row >= 5 And Target.Row <= 20 Then
If Target.Value <> "" Then MsgBox "入力済み"
End If
'
End Sub

と入れると、クリックしたセルがA5からA20のどれかで
かつセルに値が入っているときのみ”入力済み”とメッセージが表示されます。
このメッセージ表示の部分を、「名前を付けて保存」の処理に置き換えてはいかがでしょうか。

QEXCEL VBAで計算値を四捨五入、切り上げ、切捨てする方法

ネットで探してみたのですが、計算結果を四捨五入して特定のセルを
返すにはどうしたらいいのでしょうか?

Sub hokangosa()

Dim ZPS As Double
Dim ZPOS As Double
Dim DMN As Double
MsgBox (" >>> 補間誤差自動計算 <<< ")
MsgBox (" >>> 初期値入力します <<< ")
ZPS = InputBox(">>> ステップを入力してください<<<")
ZPOS = Sheet1.Cells(22, 4).Value
DMN = ZPOS / ZPS
Sheet1.Cells(23, 6).Value = DMN
End Sub

ここでDMNの値を四捨五入したいです。

またこれとは別に切上げ、切捨ても教えていただけるとありがたいです。

Aベストアンサー

DMN = Application.WorksheetFunction.Round(ZPOS / ZPS, 0)
で、四捨五入
DMN = Application.RoundDown(ZPOS / ZPS, 0)
で切り捨て
DMN = Application.RoundUp(ZPOS / ZPS, 0)
で切り上げです。

引数で、対象桁を変更できます。

Q別のシートから値を取得するとき

Worksheets("シート名").Activate
上記のを行ってから別シートの値を取得するのですが、
この処理を行うと指定したシートへ強制的にとんでしまいます。。。

※イメージ
For ~ To ~
  Worksheets("シートA").Activate
  シートAの値取得
       :
  Worksheets("シートB").Activate
  シートBの値取得
Next

このイメージ処理を行うとものすごい勢いで画面がチカチカします。。。
シートを変えずに他のシートから値を取得する方法はないのでしょうか。
教えてください!

Aベストアンサー

Worksheets("シートA").Range("A1")

みたいな感じでできませんか?

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

QEXCELファイルのカレントフォルダを取得するには?

EXCELファイルのカレントフォルダを取得するには?

C:\経理\予算.xls

D:\2005年度\予算.xls

EXCEL97ファイルがあります。

VBAで
  カレントフォルダ名
(C:\経理\,D:\2005年度\)
を取得する事は可能でしょうか?

CURDIRでは上手い方法が見つかりませんでした。

Aベストアンサー

こんばんは。
Excel97 でも、同じですね。以下で試してみてください。

Sub test()
'このブックのパス
a = ThisWorkbook.Path
'アクティブブックのパス
b = ActiveWorkbook.Path
'Excelで設定されたデフォルトパス
c = Application.DefaultFilePath
'カレントディレクトリ
d = CurDir
MsgBox "このブックのパス   : " & a & Chr(13) & _
   "アクティブブックのパス: " & b & Chr(13) & _
   "デフォルトパス    : " & c & Chr(13) & _
   "カレントディレクトリ : " & d & Chr(13)
End Sub

QEXCEL VBAで全選択範囲の解除

EXCEL VBAで
Cells.Select
と書くと、全セルが選択状態になりますが、
これを解除するには、どう書けばよいのでしょうか?

Aベストアンサー

その1
A1 など、適当なセルを選択する。
(回答#1と同じ)

その2
全選択する前の選択範囲に戻る。

全選択前に
変数 = Selection.Address で記憶

全選択後
Range(変数).Select で元の選択範囲を選択


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング