macro bij klikken op woord

Status
Niet open voor verdere reacties.
R

rowano

Gebruiker
Lid geworden
10 feb 2010
Berichten
176
Hallo,

ik heb een vraag (voor excel):
ik wil dat een bepaalde macro loopt wanneer ik op een bepaald woord klik
bijv: ik heb een cel en daarin staat: "Hallo, ik ben Rowano"
en als ik dan bijvoorbeeld op het woord "Hallo," (van spatie tot spatie) klik of dubbelklik dat dan een macro gaat lopen
 
Wat jij beschrijft lijkt me onmogelijk. Wat wel kan is controleren of er in de cel die je aanklikt "Hallo" staat. Ik heb er voor het gemak even 2 messageboxen in gezet. Op die plek kun je zelf je eigen code zetten.
Je moet de code toevoegen in VBA editor (ALT-F11) in ThisWorkbook.

Code: 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

If InStr(Target.Value, "Hallo") > 0 Then
MsgBox ("Hallo")
Else
MsgBox ("Geen hallo")
End If


End Sub


Met vriendelijke groet,

Johan van den Brink
http://www.nimda.nl
 
Laatst bewerkt:
ik heb zelf al een beetje aan een code zitten werken:
hij werkt goed, maar daarvoor moet je eerst kolom a zo breed mogelijk maken (bij mij 1234 pixels) niet op full screen zetten!!!, zoom 100% en lettertype in kolom A op "Courier New"

Code: 
Dim nietdoen, uitgeschakeld As Byte, MuisX As Integer

Sub toets()
Application.OnKey "{esc}", "thisworkbook.escape"
End Sub

Sub toets_terug()
Application.OnKey "{esc}"
End Sub

Sub escape()
uitgeschakeld = uitgeschakeld * -1 + 1 '0 -> 1 -> 0
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

If uitgeschakeld = 1 Then Exit Sub 'als je de zin wilt bewerken

If nietdoen = 1 Then
nietdoen = 0
Run "thisworkbook.woord_maken"
Exit Sub
End If
    
Dim Hold As POINTAPI
GetCursorPos Hold
MuisX = Hold.X_Pos

    
[b1:ex1] = ""

If ActiveCell = "" Then
nietdoen = 1
[a1].Select
Exit Sub
End If


        Selection.TextToColumns Destination:=Range("b1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), _
        Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array( _
        59, 1), Array(60, 1), Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1), Array(65, 1), Array(66, 1), Array(67, 1), Array(68, 1), Array(69, 1), Array(70, 1), Array(71, 1), Array(72, 1), Array(73, 1), Array(74, 1), Array(75, 1), Array(76, 1), Array(77, 1), Array(78, 1), _
        Array(79, 1), Array(80, 1), Array(81, 1), Array(82, 1), Array(83, 1), Array(84, 1), Array(85, 1), Array(86, 1), Array(87, 1), Array(88, 1), Array(89, 1), Array(90, 1), Array(91, 1), Array(92, 1), Array(93, 1), Array(94, 1), Array(95, 1), Array(96, 1), Array(97, 1), Array( _
        98, 1), Array(99, 1), Array(100, 1), Array(101, 1), Array(102, 1), Array(103, 1), Array(104, 1), Array(105, 1), Array(106, 1), Array(107, 1), Array(108, 1), Array(109, 1), Array(110, 1), Array(111, 1), Array(112, 1), Array(113, 1), Array(114, 1), Array(115, 1), Array(116, 1 _
        ), Array(117, 1), Array(118, 1), Array(119, 1), Array(120, 1), Array(121, 1), Array(122, 1), Array(123, 1), Array(124, 1), Array(125, 1), Array(126, 1), Array(127, 1), Array(128, 1), Array(129, 1), Array(130, 1), Array(131, 1), Array(132, 1), Array(133, 1), Array(134, 1), _
        Array(135, 1), Array(136, 1), Array(137, 1), Array(138, 1), Array(139, 1), Array(140, 1), Array(135, 1), Array(136, 1), Array(137, 1), Array(138, 1), Array(139, 1), Array(140, 1), Array(141, 1), Array(142, 1), Array(143, 1), Array(145, 1), Array(146, 1), Array(147, 1), _
        Array(148, 1), Array(149, 1), Array(150, 1), Array(151, 1), Array(152, 1), Array(153, 1)), TrailingMinusNumbers:=True


    nietdoen = 1
    [a1].Select
End Sub
Public Sub woord_maken()
Dim letternr, eerste, laatste, eraf, erbij, woordnrs As Integer, letter, woord, woordbw, macrorun As String


letternr = (MuisX - 21) / 8
letternr = WorksheetFunction.Round(letternr, 0)

If Cells(1, letternr) = "" Then
macrorun = "thisworkbook.spatie"
Else

    For eraf = 1 To 153
    If eraf >= letternr Then Exit For
    If Cells(1, letternr - eraf) = "" Then Exit For
    Next eraf
    eerste = letternr - eraf
    
    For erbij = 1 To 153
    If erbij + letternr >= 153 Then Exit For
    If Cells(1, letternr + erbij) = "" Then Exit For
    Next erbij
    laatste = letternr + erbij
    
    For woordnrs = eerste To laatste
    letter = Cells(1, woordnrs)
    woord = woord & letter
    Next woordnrs
    
End If
[b1:ex1] = ""

woordbw = woord

'tekens weg
woordbw = Replace(woordbw, ",", "")
woordbw = Replace(woordbw, ".", "")
woordbw = Replace(woordbw, ";", "")
woordbw = Replace(woordbw, ":", "")
woordbw = Replace(woordbw, "/", "")
woordbw = Replace(woordbw, "\", "")
woordbw = Replace(woordbw, "'", "")
woordbw = Replace(woordbw, ">", "")
woordbw = Replace(woordbw, "<", "")
woordbw = Replace(woordbw, "?", "")
woordbw = Replace(woordbw, "|", "")
woordbw = Replace(woordbw, "[", "")
woordbw = Replace(woordbw, "]", "")
woordbw = Replace(woordbw, "{", "")
woordbw = Replace(woordbw, "}", "")
woordbw = Replace(woordbw, "!", "")
woordbw = Replace(woordbw, "@", "")
woordbw = Replace(woordbw, "#", "")
woordbw = Replace(woordbw, "$", "")
woordbw = Replace(woordbw, "%", "")
woordbw = Replace(woordbw, "^", "")
woordbw = Replace(woordbw, "&", "")
woordbw = Replace(woordbw, "*", "")
woordbw = Replace(woordbw, "(", "")
woordbw = Replace(woordbw, ")", "")
woordbw = Replace(woordbw, "_", "")
woordbw = Replace(woordbw, "-", "")
woordbw = Replace(woordbw, "+", "")
woordbw = Replace(woordbw, "=", "")
woordbw = Replace(woordbw, "`", "")
woordbw = Replace(woordbw, "~", "")

'getallen weg
woordbw = Replace(woordbw, "1", "")
woordbw = Replace(woordbw, "2", "")
woordbw = Replace(woordbw, "3", "")
woordbw = Replace(woordbw, "4", "")
woordbw = Replace(woordbw, "5", "")
woordbw = Replace(woordbw, "6", "")
woordbw = Replace(woordbw, "7", "")
woordbw = Replace(woordbw, "8", "")
woordbw = Replace(woordbw, "9", "")
woordbw = Replace(woordbw, "0", "")

'hoofdletter door kleine
woordbw = Replace(woordbw, "Q", "q")
woordbw = Replace(woordbw, "W", "w")
woordbw = Replace(woordbw, "E", "e")
woordbw = Replace(woordbw, "R", "r")
woordbw = Replace(woordbw, "T", "t")
woordbw = Replace(woordbw, "Y", "y")
woordbw = Replace(woordbw, "U", "u")
woordbw = Replace(woordbw, "I", "i")
woordbw = Replace(woordbw, "O", "o")
woordbw = Replace(woordbw, "P", "p")
woordbw = Replace(woordbw, "A", "a")
woordbw = Replace(woordbw, "S", "s")
woordbw = Replace(woordbw, "D", "d")
woordbw = Replace(woordbw, "F", "f")
woordbw = Replace(woordbw, "G", "g")
woordbw = Replace(woordbw, "H", "h")
woordbw = Replace(woordbw, "J", "j")
woordbw = Replace(woordbw, "K", "k")
woordbw = Replace(woordbw, "L", "l")
woordbw = Replace(woordbw, "Z", "z")
woordbw = Replace(woordbw, "X", "x")
woordbw = Replace(woordbw, "C", "c")
woordbw = Replace(woordbw, "V", "v")
woordbw = Replace(woordbw, "B", "b")
woordbw = Replace(woordbw, "N", "n")
woordbw = Replace(woordbw, "M", "m")

macrorun = "thisworkbook." & woordbw
On Error GoTo Weg
Run macrorun
Weg:
End Sub

Sub ik()
'als het aangeklikte woord "ik" is
MsgBox ("ik" & vbNewLine & "persoonlijk voornaamwoord" & vbNewLine & "als je het over jezelf hebt en je bent het onderwerp van de zin" & vbNewLine & vbNewLine & "DIT WAS MAAR EEN VOORBEELD")
End Sub

Sub hallo()
'als het aangeklikte woord "hallo" is
MsgBox "hallo"
End Sub

PS Uw code werkte ook goed maar werkte al wanneer je op een cel klikte met het woord erin en ik had er een nodig wanneer je op het woord zelf klikte
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan