• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

macro copy ...

  • Onderwerp starter Onderwerp starter STM
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.

STM

Gebruiker
Lid geworden
30 jan 2012
Berichten
69
Geachte,

ik heb een macro opgenomen om een werkblad te kopiëren met daarin 3 formulier besturings elementen aanwezig.
Wanneer deze uitgevoerd word dan plaatst hij zowel in het origineel als in het origineel (2) blad 3 extra formulier besturings elemeenten erbovenop. Hoe kan ik dat voorkomen?

Zie hieronder de code


module1
------------

Sub Knop47_Klikken()
'
' Knop47_Klikken Macro
'

'
Application.Goto Reference:="R155C1"
End Sub
Sub Knop48_Klikken()
'
' Knop48_Klikken Macro
'

'
Application.Goto Reference:="R1C1"
End Sub

module2
---------------------------

Sub Knop49_Klikken()
'
' Knop49_Klikken Macro
'

'
Sheets("origineel").Select
ActiveSheet.Spinners.Add(234, 0, 34.8, 48).Select
ActiveSheet.Spinners.Add(453, 0, 35.4, 48).Select
ActiveSheet.Spinners.Add(234, 2215.8, 34.8, 0).Select
ActiveSheet.Spinners.Add(453, 2215.8, 35.4, 0).Select
ActiveSheet.Spinners.Add(1390.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(1390.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 2215.8, 0, 0).Select
ActiveSheet.Spinners.Add(2806.8, 2215.8, 0, 0).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 2215.8, 0, 0).Select
ActiveSheet.Spinners.Add(2806.8, 2215.8, 0, 0).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Spinners.Add(2806.8, 0, 0, 48).Select
ActiveSheet.Buttons.Add(23.4, 10.2, 140.4, 37.2).Select
ActiveSheet.Buttons.Add(17.4, 2460.6, 109.2, 45).Select
ActiveSheet.Buttons.Add(636.6, 10.2, 205.8, 21.6).Select
Sheets("origineel").Copy After:=Sheets(3)
Sheets("origineel (2)").Select
Range("A1").Select
End Sub


Dank bij voorbaat voor de geboden hulp,

JO
 
aanvulling macro fout

ik maak een copy via R-muisknop op het tabblad origineel
--Blad verplaatsen of kopiëren - copy maken - anavinken naar einde gaan.
En dan bekom je bovenstaande code wat hij perfect uitvoert bij toewijzing aan de button.

Maar bij het heropenen bestand en aanklikken van deze button krijg ik een nieuw werkblad correct maar met extra knoppen erop alsook op het originele werkblad.

Of is er een andere oplossing, voor het automatiseren van een werkblad?

Jo
 
Macro werkt nu

DANK VOOR DE REACTIES

DIT IS DE OPLOSSING GEWORDEN VOOR HET GESTELDE PROBLEEM



Sub Knop49_Klikken()
'
' Knop49_Klikken Macro
'

'Sub Nieuw_werkblad()

Do
c00 = InputBox("Nieuwe naam")
Loop Until Not Evaluate("isref(" & c00 & "!d1)")
If c00 = "" Then Exit Sub

With Sheets("origineel")
.Visible = 1
.Copy , Sheets(Sheets.Count)
.Visible = 1
End With
Sheets(Sheets.Count).Name = c00

Range("D1:H1").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=90
Range("D121:H121").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.LargeScroll Down:=-3
ActiveSheet.Shapes("Spinner 2").Select
Application.CutCopyMode = False
Selection.Delete
ActiveSheet.Shapes("Spinner 1").Select
Selection.Delete
ActiveSheet.Shapes("Button 45").Select
Selection.Delete
ActiveSheet.Shapes("Button 47").Select
Selection.Delete
ActiveWindow.SmallScroll Down:=108
ActiveSheet.Shapes("Button 46").Select
Selection.Delete
ActiveWindow.LargeScroll Down:=-4

End Sub


jo
 
STM,


Leuk dat je macro nu wewrkt.
Zou je de volgende keer je code willen selecteren en boven in het menu op # klikken.
Dan kom je code in een apart vak te staan.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan