Excel - Dropdown uitbreiden met behoud van huidige selectie

Pagina: 1
Acties:

Vraag


Acties:
  • 0 Henk 'm!

  • BBBrt
  • Registratie: Maart 2011
  • Laatst online: 23:09
Hoi allemaal,

Ik probeer wat VBA op te stellen om een batch Excel-bestanden in één keer te wijzigen. Mijn kennis van VBA gaat alleen niet zo ver. Het is me gelukt om een batch-script te maken, die alle bestanden in een bepaalde folder afgaat en daar wijzingen in aanbrengt.

Wat me nog niet lukt is een specifieke aanpassingen die ik wil doen. In de betreffende sheets staan meerdere dropdowns met een x aantal keuzemogelijkheden. Ik wil daar graag één optie aan toevoegen, maar met behoud van de keuze die eventueel al gemaakt is. In die laatste eis zit hem de crux: ik heb geen idee hoe ik dat moet doen.

Iemand? :)

Alle reacties


Acties:
  • 0 Henk 'm!

  • F_J_K
  • Registratie: Juni 2001
  • Niet online

F_J_K

Moderator CSA/PB

Front verplichte underscores

Het zou helpen als je het relevante deel van je huidige code zou geven :Y)

Wat voor soort dropdowns?

In het algemeen:
- loop de dropdowns langs
- vraag de huidige selectie op (of merk op dat die nu leeg is)
- voeg optie toe
- zet selectie terug
- volgende dropdown

'Multiple exclamation marks,' he went on, shaking his head, 'are a sure sign of a diseased mind' (Terry Pratchett, Eric)


Acties:
  • 0 Henk 'm!

  • McMark
  • Registratie: Oktober 2006
  • Laatst online: 21:21
Dat inderdaad.

Of je maakt een drop down op basis van een dynamische named range.

Acties:
  • 0 Henk 'm!

  • Icephase
  • Registratie: Mei 2008
  • Laatst online: 09-10 08:42

Icephase

Alle generalisaties zijn FOUT!

Als het via Valideren is gedaan, kun je de oorspronkelijke reeks opzoeken en 1 regel tussenvoegen. Excel past dan feitelijk niks aan, maar je hebt de range wel uitgebreid.

Acties:
  • 0 Henk 'm!

  • BBBrt
  • Registratie: Maart 2011
  • Laatst online: 23:09
Bedankt voor de reacties. Ik heb nu onderstaand voorbeeld van internet geplukt en daarmee lukt het me om een of meerdere cellen naar wens aan te passen in meerdere bestanden.

Excuus, ik dacht dat er maar 1 soort dropdown was :)
De dropdowns zijn via valideren gedaan, dus ik hoop dat je gelijk hebt en het kan door een regel tussen te voegen. Maar hoe? Wat voorbeelden van internet plukken lukt me wel, maar daarna houdt mijn kennis snel op.

Het gaat om dropdowns met gegevensvalidatie. Als lijst wordt er een reeks van 3 waarden uit een andere sheet binnen het werkboek gehaald. Ik heb daar een waarde bij laten schrijven met mijn 'script', maar de range van de gegevensvalidatie pas je daar natuurlijk niet mee aan. Dus dit haalt helemaal niks uit.

Wat mij betreft hoeft het geen 'mooie' oplossing te zijn: de keuzelijst hoeft niet gesorteerd te worden of op een bepaalde volgorde te staan. Zo lang ik maar een extra keuze kan toevoegen én de eventueel al gemaakte keuze in de dropdown behouden blijft...

Hoe o hoe? :)


Sub BatchEdit()
Dim MyPath As String
Dim MyFile As String
Dim dirName As String

dirName = "c:\test\"

MyPath = dirName & "*.xlsx"
MyFile = Dir(MyPath)
If MyFile > "" Then MyFile = dirName & MyFile

Do While MyFile <> ""
If Len(MyFile) = 0 Then Exit Do

Workbooks.Open MyFile

With ActiveWorkbook

Range("A1").Value = "TEST"

End With

ActiveWorkbook.Close SaveChanges:=True

MyFile = Dir
If MyFile > "" Then MyFile = dirName & MyFile
Loop
End Sub

Acties:
  • 0 Henk 'm!

  • BBBrt
  • Registratie: Maart 2011
  • Laatst online: 23:09
Ok, ik ben (denk ik) een stapje verder. Het zou inderdaad gewoon moeten lukken door mijn lijst met opties uit te breiden door het invoegen van een extra waarde. Ik mijn acties opgenomen en vervolgens dit in mijn 'basis' geplakt. Onderstaand het resultaat.

Ik krijg nu alleen direct een foutmelding: 'subscript valt buiten het bereik'.

Wat gaat er mis? :)
Visual Basic:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub BatchEdit()
    Dim MyPath As String
    Dim MyFile As String
    Dim dirName As String

    dirName = "C:\test\"

    MyPath = dirName & "*.xlsx"
    MyFile = Dir(MyPath)
    If MyFile > "" Then MyFile = dirName & MyFile

    Do While MyFile <> ""
        If Len(MyFile) = 0 Then Exit Do

        Workbooks.Open MyFile
      
    Sheets("Sheet3").Select
    Range("E52:E53").Select
    Selection.Cut Destination:=Range("F52:F53")
    Range("E53").Select
    ActiveCell.FormulaR1C1 = "Test"
    Range("F52").Select
    Selection.Copy
    Range("E52:E53").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

        ActiveWorkbook.Close SaveChanges:=True

        MyFile = Dir
        If MyFile > "" Then MyFile = dirName & MyFile
    Loop
End Sub

[ Voor 0% gewijzigd door F_J_K op 28-02-2020 11:46 . Reden: code tags toegevoegd ]


Acties:
  • 0 Henk 'm!

  • F_J_K
  • Registratie: Juni 2001
  • Niet online

F_J_K

Moderator CSA/PB

Front verplichte underscores

Loop de code even met F8 in de editor stap voor stap door, dan zie je op welke regel het fout gaat.

Opent Sheets("Sheet3").Select wel de juiste sheet, in het juiste bestand? Het lijkt me beter om expliciet het juiste workbook aan te spreken.

offtopic:
Ik zou heel erg nooit .select willen gebruiken. Dat gaat een keer goed fout. Roep direct de juiste bereiken aan zonder .select. Ook cut en paste gebruiken is erg foutgevoelig omdat je dan er op moet vertrouwen dat de gebruiker niets in het klembord heeft.

'Multiple exclamation marks,' he went on, shaking his head, 'are a sure sign of a diseased mind' (Terry Pratchett, Eric)


Acties:
  • 0 Henk 'm!

  • BBBrt
  • Registratie: Maart 2011
  • Laatst online: 23:09
Daar gaat het inderdaad mis. Na select sheet, gaat het mis (op select range).

Hoe spreek ik expliciet een juiste workbook aan? Zoals ik aangaf is mijn kennis van VBA heel beperkt :)

Wat ik wil is dat hij dus alle .xlsx bestanden in de opgegeven map 1 voor 1 opent, aanpast en weer opslaat.
Na openen moet hij eigenlijk direct naar het tabblad 'Sheet3' en daar de aanpassing doen die ik wil...

Bedankt alvast!

Acties:
  • 0 Henk 'm!

  • F_J_K
  • Registratie: Juni 2001
  • Niet online

F_J_K

Moderator CSA/PB

Front verplichte underscores

Bijv. met Set wb = Workbooks.Open MyFile
En dan kan je de juiste bereiken aanroepen via iets als wb.worksheets(1).range("A1:Z99")

'Multiple exclamation marks,' he went on, shaking his head, 'are a sure sign of a diseased mind' (Terry Pratchett, Eric)


Acties:
  • 0 Henk 'm!

  • Icephase
  • Registratie: Mei 2008
  • Laatst online: 09-10 08:42

Icephase

Alle generalisaties zijn FOUT!

Waarom in godesname via Visual Basic? Zoek gewoon de range op waarnaar verwezen wordt via Valideren en voeg daar een regel tussen... dan ben je klaar.

Sorry, niet goed gelezen dat je via een script hetzelfde wil doen bij meerdere bestanden in 1x... Mijn opmerking geldt alleen bij 1 bestand.

[ Voor 33% gewijzigd door Icephase op 28-02-2020 12:19 ]


Acties:
  • 0 Henk 'm!

  • BBBrt
  • Registratie: Maart 2011
  • Laatst online: 23:09
F_J_K schreef op vrijdag 28 februari 2020 @ 12:15:
Bijv. met Set wb = Workbooks.Open MyFile
En dan kan je de juiste bereiken aanroepen via iets als wb.worksheets(1).range("A1:Z99")
ik weet dat ik misschien veel vraag, maar zou je dit kunnen toepassen in mijn code? ik zit nu maar wat aan te rommelen en krijg het niet voor elkaar ;w

Acties:
  • 0 Henk 'm!

  • BBBrt
  • Registratie: Maart 2011
  • Laatst online: 23:09
ow, volgens mij lukt het zo. even testen op de batch.

Visual Basic:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub BatchEdit()
    Dim MyPath As String
    Dim MyFile As String
    Dim dirName As String

    dirName = "C:\test\"

    MyPath = dirName & "*.xlsx"
    MyFile = Dir(MyPath)
    If MyFile > "" Then MyFile = dirName & MyFile

    Do While MyFile <> ""
        If Len(MyFile) = 0 Then Exit Do

Set wkb=Workbooks.Open (MyFile)
      
    wkb.Sheets("Sheet3").Select
    Range("E52:E53").Select
    Selection.Cut Destination:=Range("F52:F53")
    Range("E53").Select
    ActiveCell.FormulaR1C1 = "Test"
    Range("F52").Select
    Selection.Copy
    Range("E52:E53").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

        ActiveWorkbook.Close SaveChanges:=True

        MyFile = Dir
        If MyFile > "" Then MyFile = dirName & MyFile
    Loop
End Sub

Acties:
  • 0 Henk 'm!

  • F_J_K
  • Registratie: Juni 2001
  • Niet online

F_J_K

Moderator CSA/PB

Front verplichte underscores

Heb ik niet echt tijd voor ;)

In plaats van
Sheets("Sheet3").Select
Range("E52:E53").Select
Selection.Cut Destination:=Range("F52:F53")

Kan je doen:
Set wb = Workbooks.Open MyFile
Set sht = wb.Sheets("Sheet3")
Set rng = sht.Range("E52:E53")
rng.Cut Destination:=Range("F52:F53")

etc.

Edit: ah had je zelf al door, mooi :)

[ Voor 6% gewijzigd door F_J_K op 28-02-2020 13:26 ]

'Multiple exclamation marks,' he went on, shaking his head, 'are a sure sign of a diseased mind' (Terry Pratchett, Eric)

Pagina: 1