• 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.

Opmaak bepalen in Array

Status
Niet open voor verdere reacties.
W

wieter

Terugkerende gebruiker
Lid geworden
26 jun 2009
Berichten
1.128
Is het mogelijk om in een "Array" de opmaak van de cellen te bepalen?
Zodat het gekleurde deel in de code niet moet ingetikt worden?
Code: 
Private Sub CommandButton1_Click()
If ComboBox3.Value = "" Then
    MsgBox "Je moet een plaats kiezen"
    Exit Sub
End If
ar = Array(ComboBox3.Value, TextBox1.Value, TextBox2.Value, TextBox3.Value, TextBox4.Value, ComboBox2.Value, TextBox6.Value, _
    TextBox5.Value, TextBox7.Value, TextBox8.Value, TextBox9.Value, TextBox10.Value, TextBox11.Value)
Sheets("Invoer").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 13) = ar
    [COLOR="#FF0000"]With Sheets("Invoer")
         .Range("A:M").Columns.AutoFit
         .Range("A:M").HorizontalAlignment = xlCenter[/COLOR]   
 [COLOR="#FF0000"]End With[/COLOR]
 
VenA raadde me aan om een "Array" te gebruiken om onderstaande code te verkorten (=sneller)
Code: 
For s = 1 To Sheets.Count
   If Sheets(s).Name = plaats Then GoTo verder1
  Next
     Sheets.Add after:=Sheets(Sheets.Count)
     Sheets(Sheets.Count).Name = plaats
       With Sheets(plaats)
         .Cells(2, 2) = "Naam": .Cells(2, 2).Interior.ColorIndex = 15
         .Cells(2, 3) = "Achternaam": .Cells(2, 3).Interior.ColorIndex = 15
         .Cells(2, 4) = "Tussenvoegsel": .Cells(2, 4).Interior.ColorIndex = 15
         .Cells(2, 5) = "Geboortejaar": .Cells(2, 5).Interior.ColorIndex = 15
         .Cells(2, 6) = "Geslacht": .Cells(2, 6).Interior.ColorIndex = 15
         .Cells(2, 7) = "Gewicht": .Cells(2, 7).Interior.ColorIndex = 15
         .Cells(2, 8) = "Gewogen": .Cells(2, 8).Interior.ColorIndex = 15
         .Cells(2, 9) = "Kyu": .Cells(2, 9).Interior.ColorIndex = 15
         .Cells(2, 10) = "Indeling": .Cells(2, 10).Interior.ColorIndex = 15
         .Cells(2, 11) = "Weegtijd": .Cells(2, 11).Interior.ColorIndex = 15
         .Cells(2, 12) = "Aanvangstijd": .Cells(2, 12).Interior.ColorIndex = 15
         .Cells(2, 13) = "JBN": .Cells(2, 13).Interior.ColorIndex = 15
         .Range("B:M").Columns.AutoFit
         .Range("B:M").HorizontalAlignment = xlCenter
         .Range("B2:M2").Borders.Weight = xlThin
      End With
verder1:
 With Sheets(plaats)
       vrijerij = .Range("M" & .Rows.Count).End(xlUp).Row + 1
      .Cells(vrijerij, 2) = Naam
      .Cells(vrijerij, 3) = Achternaam
      .Cells(vrijerij, 4) = Tussenvoegsel
      .Cells(vrijerij, 5) = Geboortejaar
      .Cells(vrijerij, 6) = Geslacht
      .Cells(vrijerij, 7) = Gewicht
      .Cells(vrijerij, 8) = Gewogen
      .Cells(vrijerij, 9) = Kyu
      .Cells(vrijerij, 10) = Indeling
      .Cells(vrijerij, 11) = Weegtijd
      .Cells(vrijerij, 12) = Aanvangstijd
      .Cells(vrijerij, 13) = JBN
      .Range("B:M").Columns.AutoFit
      .Range("B:M").HorizontalAlignment = xlCenter
 End With
 
zo iets?
Code: 
Private Sub CommandButton1_Click()
Dim R As Range
If ComboBox3.Value = "" Then
    MsgBox "Je moet een plaats kiezen"
    Exit Sub
End If
ar = Array(ComboBox3.Value, TextBox1.Value, TextBox2.Value, TextBox3.Value, TextBox4.Value, ComboBox2.Value, TextBox6.Value, _
    TextBox5.Value, TextBox7.Value, TextBox8.Value, TextBox9.Value, TextBox10.Value, TextBox11.Value)
Set R = Sheets("Invoer").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 13)
R = ar
R.EntireColumn.AutoFit
R.HorizontalAlignment = xlCenter
 
Hey Sylvester,
Jouw voorstel blijkt niet te werken.
De code loopt stuk op
Code: 
R.EntireColumn.AutoFit
Toch bedankt voor de inbreng.
ps. Het is allemaal niet zo dramatisch. Het bestand werkt perfect met de code zoals ze nu is.
Ik was zo maar wat aan het experimenteren met VBA.
 
Natuurlijk werkte het, is was vergeten om R te declareren. (Hoe dom kan je zijn)
Tof van je Sylvester, om je tijd in mijn experiment te steken.
Bedankt!!!
 
VenA raadde me aan om een "Array" te gebruiken om onderstaande code te verkorten (=sneller)
Klik om te vergroten...
Heb je in je voorbeeldbestandje al aardig toegepast:thumb:

Hoewel het draadje als opgelost gemarkeerd staat. Hier nog een andere mogelijkheid.

Code: 
Private Sub CommandButton1_Click()
If ComboBox3.Value = "" Then
    MsgBox "Je moet een plaats kiezen"
    Exit Sub
End If

If IsError(Evaluate(ComboBox3.Value & "!A1")) Then
    Sheets.Add(, Sheets(Sheets.Count)).Name = ComboBox3.Value
    With Cells(1).Resize(, 13)
        .Value = Array("Plaats", "Naam", "Achternaam", "Tussenvoegsel", "Geboortejaar", "Geslacht", "Gewicht", "Gewogen", "Kyu", "Indeling", _
        "Weegtijd", "Aanvangstijd", "JBN")
        .Interior.ColorIndex = 15
    End With
End If

With Sheets(ComboBox3.Value)
    .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 13) = Array(ComboBox3.Value, TextBox1.Value, TextBox2.Value, TextBox3.Value, _
    TextBox4.Value, ComboBox2.Value, TextBox6.Value, TextBox5.Value, TextBox7.Value, TextBox8.Value, TextBox9.Value, TextBox10.Value, TextBox11.Value)
    .Columns.AutoFit
End With
Unload Me
End Sub
 
Laatst bewerkt:
De 'if' net even op een andere plaats anders wordt het niet weggeschreven als het blad wel bestaat, + blad 'plaatsen' wordt aangevuld voor je combobox + het gevraagde over xlcenter.

Altijd vreemd dat gebruikers de eerste rij vaak overslaan.

Code: 
Private Sub CommandButton1_Click()
If ComboBox3.Value = "" Then
    MsgBox "Je moet een plaats kiezen"
    Exit Sub
End If
arr = Array(ComboBox3.Value, TextBox1.Value, TextBox2.Value, TextBox3.Value, _
        TextBox4.Value, ComboBox2.Value, TextBox6.Value, TextBox5.Value, TextBox7.Value, TextBox8.Value, TextBox9.Value, TextBox10.Value, TextBox11.Value)
Sheets("invoer").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 13) = arr
If IsError(Evaluate(ComboBox3.Value & "!A1")) Then
     Sheets.Add(, Sheets(Sheets.Count)).Name = ComboBox3.Value
     Sheets("Plaatsen").Cells(Rows.Count, 1).End(xlUp).Offset(1) = ComboBox3.Value
 End If
      With Sheets(ComboBox3.Value)
       With .Cells(1).Resize(, 13)
        .Value = Array("Plaats", "Naam", "Achternaam", "Tussenvoegsel", "Geboortejaar", "Geslacht", "Gewicht", "Gewogen", "Kyu", "Indeling", _
        "Weegtijd", "Aanvangstijd", "JBN")
        .Interior.ColorIndex = 15
        .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 13) = arr
       End With
        With .Columns
          .AutoFit
          .HorizontalAlignment = xlCenter
        End With
    End With
Unload Me
End Sub
 
De end if stond inderdaad nog op een verkeerde plaats. Was eerst een if then else waarbij ik de else weggehaald heb. Maar de end if niet omhoog geschoven heb.:o

De xlCenter heb ik er bewust uitgelaten. (Persoonlijke smaak)
 
Jouw persoonlijke smaak is volgens mij de essentie van de vraag. :d
 
Hey VenA en Harry,
Prachtig!! Prachtig!!
Indien je tijd en zin hebt, kan je dan de functie verklaren van "!A1" , in de onderstaande regel?
Code: 
If IsError(Evaluate(ComboBox3.Value & "!A1")) Then
@VenA, bedankt voor de code
@Harry, bedankt voor die ComboBox.List aanvulling.
Dank zij jullie weer heel wat wijzer geworden.:thumb:
 
Misschien begrijp je het zo beter @wieter.
Code: 
=als isfout(blad(combobox3.value!A1)) =waar dan
 
Harry, het zal wel aan mij liggen, maar ik begrijp het nog niet.
Naar wat verwijst die !A1 ?
 
Cel A1 van het blad wat je aanroept door de waarde van de combobox.
=Als(isfout(evalueer(Enschede!A1)) = waar; maak een blad aan met die naam; anders niet)
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan