Kopieëren tabblad

[HSV]

Ik heb het ook nog nooit eerder gehad op forums Rudi, dit is de eerste keer dat ik een melding kreeg (ook met melding hield een Macro-virus tegen).
Ik ben nu aan het scannen, inmiddels een virus gevonden.
Komt vast weer voorelkaar.

 

[trucker10]

Hallo , enkel Bitdefender heeft een Warning MacroVBA de rest laat het door als clean .

 

[Warme bakkertje]

Ik heb de macro gewoon op een tabblad geplakt dan kan je hem eens bekijken.

Mvg

Rudi

 

[Superzeeuw]

Rudi,

Je bent veel te bescheiden.
Ik heb je code gezien en dat ziet er strak uit.
Ik kan nog een hoop verbeteren als ik die code zo zie.
Ik moet vooral nog leren om de functie "With" meer te gaan gebruiken.

Nog een leuke aanvulling op jouw code.
Je kunt de reference verwijzing automatisch laten zetten bij openen programma, en inderdaad dat heb ik niet van mijzelf maar van i-net:

Private Sub Workbook_Open()
    On Error Resume Next
        'Make reference to Extensibility Library
    ThisWorkbook.VBProject.References.AddFromGuid _
            "{0002E157-0000-0000-C000-000000000046}", 4, 0
    On Error GoTo 0
End Sub

Als ik jouw code gebruik dan treed er bij mij wel een fout op, zie bijgevoegd plaatje.
Deze fout ontstaat wanneer ik een nieuw blad aanmaak en daarna terug ga naar het tabblad hoofdmenu en dan op de nieuw aangemaakte knop klik, vreemd want de eerste knop werkt wel??

P.s.: bij mij geen virusmelding.

Grtz. Edwin

 

[Superzeeuw]

Rudi,

Deel 2, met het plaatje, hahahahaha

Grtz. Edwin

 

[Superzeeuw]

Rudi,

Een aanpassing in de code zorgt ervoor dat het bij mij gaat werken.

.InsertLines LineNum, "    " & "Application.GoTo " & "[" & Naam & "!B6]"

Omgezet naar:

.InsertLines LineNum, "    " & "Application.GoTo " & "Sheets(""" & Naam & """).Range(""B6"")"

Waarom, ik ben tot de ontdekking gekomen dat een spatie problemen geeft in de code die jij hebt gebruikt, misschien is er een andere oplossing met jouw code maar die ken ik niet.

Er doet zich nog een fout voor in mijn code, er wordt namelijk niet gekeken of de nieuw ingegeven naam met een alphanummerieke waarde begint.
Begint de nieuw ingegeven naam met een nummerieke waarde dan volgt de foutboodschap:
"Eigenschap OnAction van klasse TextBox kan niet worden ingesteld."

Een modulenaam mag namelijk nooit met een nummeriek karakter beginnen, verderop mag een nummeriek karakter wel voorkomen.
Vandaar volgende code aangepast:

If Naam = "" Then Exit Sub

Naar:

If Naam = "" Or IsNumeric(Left(Naam, 1)) Then MsgBox "Ongeldige Naam ingegeven, 1ste karakter is nummeriek, of Naamveld is leeg!": Exit Sub

Grtz. Edwin

 

[BramB2]

Deze code ziet er heel erg goed uit! en werkt ook super! Eén heel klein detail is dat wanneer je op annuleren drukt je het messagebox krijgt van:
"Ongeldige Naam ingegeven, 1ste karakter is nummeriek, of Naamveld is leeg!":
Maar dit kan ik zelf hopelijk nog wel oplossen(A)

Wat me nog wel een waardevolle aanvulling lijkt is voor de tekens, is daar geen code naam voor? Iets van "If character" ?

Vraagje over het beveiligings gedeelte: Is het gedeelte over de beveiliging in de code niet weg te halen wanneer je in het hoofdmenu button 1 en rij B deblokkeerd? Of zijn dan de nieuw aangemaakte knoppen zo weg te halen?
En het tabblad Template moet ook beveiligd worden, behalve de gele cellen en B6. Dit heb ik gedaan en lijkt zonder problemen, maar geeft dit geen problemen met de code?

Hierna kan ik denk ik beginnen met implementeren, of heeft iemand nog op of aanmerkingen?

Heel bedankt heren!:thumb:

Trouwens, waarom is het tabblad info niet zichtbaar te krijgen? Alleen als ik heb via VBA exporteer.

Groeten Bram

 

[Superzeeuw]

Bram,

Leuk dat je er weer bent.
Je hebt een hoop vragen en ik zal proberen hierop antwoord te geven.

1. Maak er eventueel twee regels van, waarbij leeg en nummeriek gescheiden worden.
2. Tekens, het commando Instr = In String, dus komt het karakter in de string voor dan...
3. De nieuw aangemaakte knoppen zijn dan inderdaad weg te halen, vandaar de beveiliging
4. Tabblad Template kan zonder problemen beveiligd worden, heeft de code geen last van.
5. Tabblad info kun je zichtbaar maken in de VBA, zie plaatje.

Zijn er nog vragen dan horen we het wel.

Grtz.

 

[BramB2]

Superzeeuw,

Eensgelijks!

Ik heb geprobeerd je antwoorden in te voeren maar ben er niet helemaal uitgekomen.
1. Ik heb er twee regels van gemaakt, alleen nu geeft hij een fout melding als ik een getal invoer, dat de typen niet overeenkomen. Deze (niet werkende) code heb ik er van gemaakt:
If Naam = "" Then Exit Sub
If Naam = IsNumeric(Left(Naam, 1)) Then MsgBox "Ongeldige Naam ingegeven, 1ste karakter is nummeriek!": Exit Sub

2. Ik snapte niet precies wat je bedoeld met instring, daarom heb ik zelf wat geprobeerd met de code, en opzich werkt hij goed, alleen wanneer ik nu een spatie invoer dan maakt hij daar een _ van en beindigd hij de code ook. Code:
For j = 1 To 6
If InStr(Naam, Character) <> 0 Then MsgBox "U kunt geen tekens gebruiken": Exit Sub

3. Oke prima, is er verder nog een beveiliging in VBA die ik niet kan zien?

4. :thumb:

5. Dat lukt me niet, ik kan alleen in de eigenschappen van het VBAproject komen, kun je vertellen hoe ik bij de eigenschappen van blad 5 kom?

6. Ik heb geprobeerd de code te implementeren (zonder bovenstaande punten), dit lijkt voor mijn gevoel gelukt te zijn. Kun je even kijken of ik de code niet weer heb verprutst? Zie bijlage.

Wederom bedankt!
Groetjes Bram!

 

[Superzeeuw]

Bram,

1. Maak van dit:

If Naam = IsNumeric(Left(Naam, 1)) Then MsgBox "Ongeldige Naam ingegeven, 1ste karakter is nummeriek!": Exit Sub

Dit:

If IsNumeric(Left(Naam, 1)) Then MsgBox "Ongeldige Naam ingegeven, 1ste karakter is nummeriek!": Exit Sub

2. Laat dit stukje gewoon staan kan niet anders:

For j = 1 To 6
        If InStr(Naam, Choose(j, "\", "/", "?", "*", "[", "]")) <> 0 Then MsgBox "U heeft een ongeldig karakter opgegeven: \ / ? * [ ]": Exit Sub
    Next

3. Nee er zit geen andere beveiliging op de VBA.

4. :thumb::thumb:

5. ALT+F11 > CTRL+R > F4 > Selecteer in projectverkenner Blad5 (Info) > Ga naar Eigenschappen en bepaal daar de gewenste visibility, zie mijn vorige plaatje.

6. Zover ik kan beoordelen ziet het er goed uit, alleen op het tabblad Hoofdmenu selecteer jij B19, gaat dit goed met het positioneren van de knoppen?

Grtz.

 

[snb]

Vermijd select en activate in VBA.
Vermijd het overbodig introduceren van variabelen

Sub Nieuwblad()
  On Error Resume Next
  With Sheets.Add
    Do
      Err.Clear
      .Name = InputBox("Geef een naam")
    Loop Until Err.Number = 0
    ThisWorkbook.VBProject.VBComponents(.codename).CodeModule.AddFromString Replace(Replace(Replace("Sub wijzig()*Application.GoTo Sheets(@#@).Range(@E13@)*End Sub", "#", .name), "@", Chr(34)), "*", vbCr)
    With .Buttons.Add([B19].Left, [B19].Top, 90, 24)
       .Caption = .name
       .OnAction = .codename & ".wijzig"
     End With
   End With
End Sub

 

[BramB2]

Vermijd select en activate in VBA.
Vermijd het overbodig introduceren van variabelen

Snb, bedankt voor je reactie. Kun je mij uitleggen waarom deze dingen in VBA vermeden moeten worden?

Je code loopt wel, maar klopt niet met mijn doeleinden, en ik heb zelf helaas niet de kennis om deze code aan te passen..

@ Superzeeuw:
1. :thumb:
2. Oke, maar er zijn nog meer tekens die niet in de naam mogen komen want dan werkt de macro naar het nieuwe tabblad niet.. Moet ik dit dan oplossen door de lijst gewoon uit te breiden?
3. :thumb:
4. :thumb::thumb::thumb:
5. :thumb:
6. Oke mooi, ja de eerste knop staat inderdaad anders dan alle volgende, niet heel rampzalig maar is er wat op te verzinnen?
7. Ik heb nog een raar probleempje. Wanneer ik é'én specifieke naam invoer voor het tabblad dan gaat alles goed, alleen de nieuwe knop werkt niet. Hij zegt dat de macro niet beschikbaar is, en als ik dan bij macro's kijk staat hij er in als: Module1."naam"
Enig idee hoe dit kan?

Wederom erg bedankt
Groeten!

 

[snb]

Select en actvate zijn vertragend en overbodig, want gebruikergebonden. In VBA kun je rechtstreeks objekten benaderen.
Een goede macro heeft dan ook zelden application.screenupdating=false nodig, omdat er op het scherm meestal niets hoeft te gebeuren.
Kortom: select en activate is 'opneem' VBA. (via de macrorecorder)

En mijn bijdrage is eerder bedoeld voor degenen die dat wél kunnen waarderen en jou in deze draad proberen te helpen.

 

[BramB2]

Select en actvate zijn vertragend en overbodig, want gebruikergebonden. In VBA kun je rechtstreeks objekten benaderen.
Een goede macro heeft dan ook zelden application.screenupdating=false nodig, omdat er op het scherm meestal niets hoeft te gebeuren.
Kortom: select en activate is 'opneem' VBA. (via de macrorecorder)

En mijn bijdrage is eerder bedoeld voor degenen die dat wél kunnen waarderen en jou in deze draad proberen te helpen.

Oke, bedankt voor je uitleg. Bedoel je eigenlijk dat ik de code die ik nu gebruik beter niet kan gebruiken? Hij werkt wel goed namelijk..!

Zucht, wat een vijandigheid. Tuurlijk kan ik je hulp wel waarderen, heel erg zelfs! IK kan er de code alleen niet zelf aanpassen omdat ik daar de kennis niet voor heb.

Groeten.

 

[Superzeeuw]

Bram,

2. Vul de gewneste karakters in achter het woord Choose en verhoog het getal 6 tot het aantal karakters dat je wilt filteren.

For j = 1 To 6
        If InStr(Naam, Choose(j, "\", "/", "?", "*", "[", "]")) <> 0 Then MsgBox "U heeft een ongeldig karakter opgegeven: \ / ? * [ ]": Exit Sub
Next

6. De knop is linksboven geplaatst in een cel, selecteer deze in je code waar nu [B19] staat.
7. Dit zit in de code, kijk goed naar het werkende voorbeeld en loop dit na.

.InsertLines LineNum, "Sub " & Modulenaam & "()"

Bovenstaande regel is heel belangrijk.

SNB,
Je hebt helemaal gelijk met de opmerking over selecteren en activeren, deze werken zeker erg vertragend.
Het wordt zeker heel erg gewaardeerd en het zijn iedere keer behoorlijke leermomenten.
Wat wel een punt is, is dat jouw VBA programmeer niveau erg hoog ligt en niet iedereen dit kan volgen of direct begrijpt of zomaar 1,2,3 kan implementeren in zijn eigen VBA-code.
Het is heel moeilijk als je altijd select en activate hebt gebruikt om dit dan maar even om te gooien, daar gaat behoorlijk veel moeite en tijd in zitten.
Ik hoop dat je het begrijpt maar dat je zeker niet wilt stoppen met deze wijze woorden.
We gaan er zeker iets mee doen en hopelijk komen we tot een punt dat select en activate tot een ver verleden behoren.

Grtz.

 

[Warme bakkertje]

snb heeft volkomen gelijk in zijn statement in #73, maar aangezien het hier gaat om objecten uit de formuliercollectie zou je voor elke knop alle eigenschappen moeten gaan instellen alsook moet je dan aan plaatsbepaling gaan doen tov van de andere knoppen voor de plaatsing enz.
Daarom lijkt me dit maar een kleine zonde om het zo op te lossen. Zet je eerste knop op B19
Onderstaande zou ons weer verder moeten helpen

Sub NewSheet()
    Dim UnlockCode As String, Naam As String
    UnlockCode = "Aanpassen"
Naam:
    Naam = Replace(InputBox("Geef NAAM nieuwe tabblad in: "), " ", "_")
    If Naam = vbNullString Then
        Exit Sub
    ElseIf IsNumeric(Left(Naam, 1)) Then MsgBox "Ongeldige Naam ingegeven, 1ste karakter is nummeriek !": GoTo Naam:
    End If
    For sh = 1 To Worksheets.Count
        If UCase(Naam) = UCase(Sheets(sh).Name) Then MsgBox "Deze naam komt al voor!": GoTo Naam:
    Next sh
    For j = 1 To 6
        If InStr(Naam, Choose(j, "\", "/", "?", "*", "[", "]")) <> 0 Then MsgBox "U heeft een ongeldig karakter opgegeven \ / ? * [ ]": GoTo Naam:
    Next
    Application.ScreenUpdating = False
    On Error Resume Next
    On Error GoTo 0
    ThisWorkbook.VBProject.VBComponents("Module1").CodeModule _
    .AddFromString Replace(Replace(Replace("Sub #()*Application.GoTo Sheets(@#@).Range(@E13@)*End Sub", "#", Naam), "@", Chr(34)), "*", vbCr)
    With ActiveSheet
        .Unprotect Password:=UnlockCode
        .Shapes("Button 1").Copy
        .[A19].Select
        .Paste
    End With
    With Selection
        .ShapeRange.IncrementTop 34 * [Info!B1].Value
        .Characters.Text = Naam
        .OnAction = Naam
    End With
    ActiveSheet.Protect Password:=UnlockCode
    Sheets("Uitsnijden").Copy Before:=Sheets("Uitsnijden")
    Sheets("Uitsnijden (2)").Name = Naam
    With Sheets(Naam)
        .Visible = True
        .[E13].Value = Naam
    End With
    [Info!B1].Value = [Info!B1].Value + 1
    Application.ScreenUpdating = True
End Sub

Mvg

Rudi

 

[BramB2]

Heren!

@ superzeeuw:
Punt 2 gaat me wel lukken!
Punt 6, ik snap je niet helemaal, het is de bedoeling dat de knoppen vanaf B19 geplaatst worden, moet ik hier Button 1 dan ook in plaatsen? Het gaat namelijk goed vanaf de 2e nieuwe knop.
Bedankt voor je verwoording over SNB, dat is precies wat ik bedoel! Zijn hulp word echt wel heel erg gewaardeerd!

@ Rudi:
Die code werkt ook perfect, is hij "beter" dan de vorige? Ik kom er niet uit met die knop, De nieuwe knop moet vanaf B19 geplaatst worden, maar waar moet ik dan Button 1 neerzetten, of maakt dit niet uit? Verder heb ik er geen Bugs in kunnen vinden, op 1 na
De naam mag niet langer zijn dan 31 tekens, hier staat nog niks voor in.
Ik heb wel wat geprobeerd, maar het klopt van geen kant:

If Naam = vbNullString Then
        Exit Sub
    ElseIf IsNumeric(Left(Naam, 1)) Then MsgBox "Ongeldige Naam ingegeven, 1ste karakter is nummeriek !": GoTo Naam:
    ElseIf ChrW(31) Then MsgBox "te lange naam": GoTo Naam:

Overigens, kan iemand me mischien uitleggen waar "string" voor dient? Ik denk dat het betrekking heeft op tekens maar weet het niet zeker!

Wederom bedankt voor de input jongens, het einde is in zicht!:thumb:

 

[Warme bakkertje]

String wil zeggen 'Reeks tekens ofte Tekst'

ElseIf Len(Naam) > 31 Then MsgBox "Te lange naam (max 31 tekens)": GoTo Naam:

Mvg

Rudi

 

[BramB2]

String wil zeggen 'Reeks tekens ofte Tekst'

ElseIf Len(Naam) > 31 Then MsgBox "Te lange naam (max 31 tekens)": GoTo Naam:

Mvg

Rudi

Werkt prima, bedankt!

 

[snb]

@Rudi

    With Sheets(1)
      .Shapes("Knop 1").Copy
      .Paste .[A19]
    End With