code-depot for VBA

URL / Comment

'-----------------------------------------------------------

'■左シングルクリックをトラップする(オマケ付き)

'abyssinia.bbs.fc2.com/ act=reply&tid=2800138#14640471

 

'対象範囲

Private Const myAra As String = "A1:B10"

'-------------------------------------------------

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)

 

  MsgBox Target.Range.Address

  

  '　With Target.Range

  '　　Select Case .Interior.ColorIndex

  '　　　Case 6

  '　　　　.Interior.ColorIndex = xlColorIndexNone

  '　　　Case xlColorIndexNone

  '　　　　.Interior.ColorIndex = 6

  '　　End Select

  '　End With

 

End Sub

'-------------------------------------------------

Private Sub Worksheet_Change(ByVal Target As Range)

 

  Dim myRng As Range

  Dim myCel As Range

  Set myRng = Intersect(Target, Range(myAra))

  If myRng Is Nothing Then Exit Sub

  

  For Each myCel In myRng

    With myCel

      If .Value <> "" Then

        .Hyperlinks.Delete

        .Hyperlinks.Add _

          Anchor:=myCel, _

          Address:="", _

          SubAddress:=.Address(External:=True)

        .Style = "Normal"

        .NumberFormatLocal = "@* "

      End If

    End With

  Next myCel

 

End Sub

'-----------------------------------------------------------