Macro in een macro activeren

[Hans290875]

Ik heb een macro 'spel wissen' gemaakt, die door de vraag te stellen 'welk spel gewist moet worden', als antwoord krijgt 1,2 of 3.
Aan de hand van het gegeven antwoord, wordt een volgende macro (bladleegmaken1, bladleegmaken2 of bladleegmaken3) geactiveerd.
De macro's bladleegmaken1 - 2 en 3 werken goed, alleen de macro spel wissen stuurt niet de juiste macro aan.

Het zal wel iets heel kleins zijn, maar ik weet het niet.

Onderstaand de macro's.

Sub spelwissen()
lijst = ";1;2;3;"
answ = InputBox("Welk spel leegmaken?")
If InStr(lijst, ";" + answ + ";") = 1 Then
Call Bladleegmaken1
End If
If InStr(lijst, ";" + answ + ";") = 2 Then
Call Bladleegmaken2
End If
If InStr(lijst, ";" + answ + ";") = 3 Then
Call Bladleegmaken3
End If
End Sub

Sub Bladleegmaken1()
'
' Bladleegmaken1 Macro
'

'
Range("C24").Select
Selection.Copy
Range("M22").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("H24").Select
Application.CutCopyMode = False
Selection.Copy
Range("N22").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("K3:X21").Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveWindow.SmallScroll Down:=21
Range("A4058").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-111
Range("O3").Select
ActiveSheet.Paste
Range("a1").Select
End Sub
Sub Bladleegmaken2()
'
' Bladleegmaken2 Macro
'

'
Range("C24").Select
Selection.Copy
Range("M23").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("H24").Select
Application.CutCopyMode = False
Selection.Copy
Range("N23").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("K3:X21").Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveWindow.SmallScroll Down:=18
Range("A4058").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-132
Range("O3").Select
ActiveWindow.SmallScroll Down:=-6
ActiveSheet.Paste
Range("a1").Select
End Sub
Sub Bladleegmaken3()
'
' Bladleegmaken3 Macro
'

'
Range("C24").Select
Selection.Copy
Range("M24").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("H24").Select
Application.CutCopyMode = False
Selection.Copy
Range("N24").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("K3:X21").Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveWindow.SmallScroll Down:=18
Range("A4058").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-225
Range("O3").Select
ActiveWindow.SmallScroll Down:=-36
ActiveSheet.Paste
Range("a1").Select
End Sub

 

[Haije]

Hans,

het helpt enorm als je het excelbestand waarin deze code voorkomt plaatst (zonder "gevoelige" gegevens).
Bovendien, als je code plaatst, dan svp als code:
eerst [code.]
dan je tekst
tenslotte [/code.]

zonder de . acter code

 

[VenA]

Instr geeft de positie in een string weer en dat is wat anders dan wat jij wil.

MsgBox InStr(";1;2;3;", 2)

zal 4 als resultaat geven. Gebruik & ipv + om tekst aan elkaar te knopen.

Volgens mij is dit wel voldoende.

Sub spelwissen()
  answ = Application.InputBox("Welk spel leegmaken?", "leegmaken", , , , , , 1)
  If answ > 0 And answ < 4 Then
    Range("M21").Offset(answ) = Range("C24").Value
    Range("N21").Offset(answ) = Range("H24").Value
    Range("K3:X21").ClearContents
    Range("A4058").Copy Range("O3")
  End If
End Sub

[Edit]

Range("A4058").Copy Range("O3")

zal wel

Range("A4:D58").Copy Range("O3")

moeten zijn.
Daarom altijd code tussen codetags plaatsen en nog beter een voorbeeldbestand met de code erin.

 

[Hans290875]

Hallo Ven A,

Allereerst bedankt voor het meedenken.
Uiteraard moet Range("A4058").Select zijn Range("A4058").Select
Als ik je oplossing opneem in de macro dan krijg ik niet wat ik zoek.
Ik wil namelijk dat jouw macro, afhankelijk van het door mij gegeven antwoord (1,2 of 3), doorgaat naar macro Bladleegmaken1 (bij antwoord 1) of Bladleegmaken 2 (bij antwoord 2) of Bladleegmaken 3 (bij antwoord 3) en daarmee verder gaat.
Die macro's werken namelijk wel.

 

[VenA]

Als ik je oplossing opneem in de macro dan krijg ik niet wat ik zoek.

Lekker veelzeggend.

In de macro's staan nagenoeg dezelfde code en kan je dus simpel ondervangen zoals ik gedaan heb. Je moet het helemaal nergens in opnemen maar al jouw code verwijderen en vervangen door de code in #3. Het plaatsen van codetages en een voorbeeldbestand heb je niet begrepen?

 

[Hans290875]

Ik ben slechts een goedwillende amateur voor wat betreft het maken van macro's, dus jouw opmerking van code verwijderen e.d. is onbekend terrein voor mij.
De macro's bladleegmaken 1 t/m 3 lijken inderdaad heel sterk op elkaar, maar doen niet alle 3 hetzelfde.
Vandaar dat mijn antwoord in jouw macro één van die macro's dient te activeren.
Ik dacht dat als ik jouw macro gebruik en dan er iets in zet van 'call macro bladleegmaken1' of 'then goto bladleegmaken3', dan wordt die betreffende macro geactiveerd door jouw macro en heb ik wat ik zoek.
Hopelijk heb ik het duidelijk uitgelegd en kan je mij bij dat laatste stukje macro helpen.

 

[VenA]

Er zijn geen verschillende macro's voor nodig. Plaats het bestand nou maar eens dan zal ik wel inpassen en eventueel aanpassen.

 

[Hans290875]

Hallo VenA,

Bijgaand de bijlage.
Het gaat om het tabblad 'Computerversie'.
De eerste 5 macroknoppen werken.
Het gaat om de macroknop 'Test'.

 

[VenA]

Zoals al geschreven heb je geen andere macro's nodig. Verwijder de code in module 4 en plaats deze er voor in de plaats.

Sub spelwissen()
  answ = Application.InputBox("Welk spel leegmaken?", "leegmaken", , , , , , 1)
  If answ > 0 And answ < 4 Then
    Range("M21").Offset(answ) = Range("C24").Value
    Range("N21").Offset(answ) = Range("H24").Value
    On Error Resume Next
    Range("K3:X21").SpecialCells(2).ClearContents
  End If
End Sub

Het enige verschil in jouw 3 macro's is het wegschrijven van de punten per spel. Dat gebeurt nu door .Offset(answ). Het kopiëren van de formules is ook overbodig. Je kan gewoon de handmatig ingevulde cellen leegmaken met .SpecialCells(2).ClearContents de formules blijven dan staan. De on error resume next staat er voor het geval er niets ingevuld is. Anders krijg je een foutmelding.

 

[Hans290875]

Hallo VenA

Het is me gelukt.
Geweldig. Bedankt voor je inzet.

 

[VenA]

Kan ook nog met een regel minder.

ipv

Range("M21").Offset(answ) = Range("C24").Value
Range("N21").Offset(answ) = Range("H24").Value

Range("M21:N21").Offset(answ) = Array(Range("C24").Value, Range("H24").Value)