Versimpelen macro

[Kens62]

Beste forumleden,

Kan ik, en zo ja hoe, onderstaande macro vereenvoudigen?

-------

Sub Afgeronderechthoek0001_Klikken()

Range("F13").Select
Cells.Find(What:="0001", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
End Sub
Sub Afgeronderechthoek0002_Klikken()

Range("F13").Select
Cells.Find(What:="0002", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
End Sub
Sub Afgeronderechthoek0003_Klikken()

Range("F13").Select
Cells.Find(What:="0003", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
End Sub
Sub Afgeronderechthoek0004_Klikken()

Range("F13").Select
Cells.Find(What:="0004", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
End Sub
Sub Afgeronderechthoek0005_Klikken()

Range("F13").Select
Cells.Find(What:="0005", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
End Sub
Sub Afgeronderechthoek0006_Klikken()

Range("F13").Select
Cells.Find(What:="0006", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
End Sub
Sub Afgeronderechthoek0007_Klikken()

Range("F13").Select
Cells.Find(What:="0007", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
End Sub
Sub Afgeronderechthoek0008_Klikken()

Range("F13").Select
Cells.Find(What:="0008", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
End Sub

Sub Afgeronderechthoek0009_Klikken()

Range("F13").Select
Cells.Find(What:="0009", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
End Sub
Sub Afgeronderechthoek0010_Klikken()

Range("F13").Select
Cells.Find(What:="0010", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
End Sub
-----

Hartelijk dank voor het meedenken.

 

[HSV]

Koppel de code aan elke knop en test het eens.

Overigens xlpart verruild voor xlwhole.

[COLOR=#333333]Sub hsv_Klikken()[/COLOR]
 set c = cells.find(activesheet.button(replace(application.caller,"[COLOR=#3E3E3E]Afgeronderechthoek",""[/COLOR])),range("f13"),xlformulas,xlwhole)
 if not c is nothing then application.goto c
[COLOR=#333333]End Sub[/COLOR]

Ps: zet je code in het vervolg tussen codetags zoals die van mij en plaats er een bestandje bij.

 

[Kens62]

Bekijk bijlage Helpmij macro.xlsm

Beste HSV,

Ondanks je tip is het mij niet gelukt.
Bijgaand een voorbeeld met de bedoeling.

Met vriendelijke groet,
Hans.

 

[HSV]

Zo gaat het beter.

Sub hsv_Klikken()
 Set c = Columns(18).Find(ActiveSheet.Shapes(Application.Caller).TextEffect.Text, , , xlWhole)
 If Not c Is Nothing Then Application.Goto c
End Sub

Je kan ook met topleftcell werken als de knoppen op dezelfde rij staan als het gezochte.

 

[Kens62]

Hartelijk dank voor de reacties.

De beste oplossing voor mij was:

Sub HB_Klikken()
Set c = Columns().Find(ActiveSheet.Shapes(Application.Caller).TextEffect.Text, , , xlWhole)
If Not c Is Nothing Then Application.Goto c

End Sub

 

[HSV]

Daar waar columns() staat was cells of columns ook genoeg