UserForm aanpassen en updaten in Sheets mbv VBA

Status
Niet open voor verdere reacties.
R

royb73

Gebruiker
Lid geworden
19 sep 2012
Berichten
228
Beste leden,

Ik heb een formulier gemaakt die gebruikt zou moeten worden voor inspectie. Ik ben al een heel eind.

Ik heb de volgende problemen nog:

1. textbox (TbxEVSA1) moet de waarde weergeven o.b.v. waarden CbxSoort1 (kolom A sheet " Verlichting") en CbxType1 (kolom B). TbxESVA1 komt uit kolom C sheet "verlichting".

2. Lege regels dienen uit CbxType1 verwijderd te worden.

3. De waarden van FrRuimteGegevens (Framebox) komt uit sheet "AutoCAD Data". De waarden in deze groep gaat goed. Echter moeten de waarden vanaf verlichting (tot ventilatie) overgenomen worden uit sheet ("Algemeen"). Leidend hierin is de Ruimtenummer (Combobox1=unieke nummers) en moet op basis hiervan de waardes opgezocht worden (verlichting t/m ventilatie).

4. Combobox1 (=ruimtenummers) mag niet gewijzigd worden. Dit zijn unieke nummers. De rest in dit Frame kan/mag gewijzigd worden. Bij wijzigingen van de waarden in deze groep/Frame, dient de waarden geupdate / opgeslagen worden in sheet "AutoCAD data" in desbetreffende kolom/regel. Voordat er opgeslagen wordt, dient er een melding te komen dat velden/waarden zijn gewijzigd en opgeslagen/overschreven worden.

5. Wijzigingen in Userform bij comboboxen / textboxes (verlichting / Ventilatie / Opmerking / Gebouwdeel / Energiesector) moeten geupdate worden in sheet "Algemeen" in desbetreffende kolom/regel (op basis van ruimtenummer zoeken en updaten).

Ik hoop dat jullie mij hiermee verder kunnen helpen. Mijn kennis van VBA is beperkt en vraag jullie hierbij.

Bijgaand het bestand.

Bekijk bijlage TestTemplate2.xlsm

Alvast bedankt.

Met vriendelijke groet,

Roy
 
Bedoel je zoiets als dit?
 

Bijlagen

  • TestTemplate.xlsb
    81,7 KB · Weergaven: 44
Beste Jack,

Bedankt voor je reactie.

Ik zal dit checken en laat je dan weten.

Mvg
Roy
 
Heb nog code achter de update knop gezet.
 

Bijlagen

  • TestTemplate.xlsb
    84,9 KB · Weergaven: 47
Oké bedankt. Ik was nog iets vergeten om aan te geven. Indien tbxGO leeg is en ik de lengte en breedte maat invoer in desbetreffende textboxen, hoe krijg ik de waarde hiervan ingevuld in TbxGO?

Mvg
Roy
 
Zet deze code er maar tussen
Code: 
Private Sub ComboBox1_Change()
  With Blad8
    j = .Columns(1).Find(ComboBox1, , , xlWhole).Row
      TbxBouwLaag = .Cells(j, 2).Value
      TbxGO = .Cells(j, 5).Value
      TbxLengte = .Cells(j, 14).Value
      TbxBreedte = .Cells(j, 15).Value
      TbxHoogte = .Cells(j, 6).Value
      CbxGebruiksfunctie = .Cells(j, 4).Value
  End With
    
[COLOR=#0000cd]  If TbxGO = "" And TbxLengte <> "" And TbxBreedte <> "" Then
     Me.TbxGO.Value = CDbl(TbxLengte.Value * TbxBreedte.Value)
  End If[/COLOR]
  
  With ComboBox1
 
Beste Jack,

Bedankt voor de codes. De codes zien nu overzichterlijker uit!

Nog enkele opmerkingen. Dit formulier is gebaseerd op ruimtenummers wat leidend is. Alles wordt namelijk opgeslagen op ruimtenummernivo (Combobox1).

- Indien Combobox1 (ruimtenummer) leeg is, wordt momenteel de velden opgeslagen in rij 2 van sheet "Algemeen" ipv achter een ruimtenummer. Indien er geen ruimtenummer is geselecteerd, dan zou ik ook geen andere velden kunnen selecteren. Er zou een message moeten komen met als melding: "Selecteer eerst een ruimtenummer om verder te gaan".
- Bij wijzigingen van de waarden (TbxLengte, TbxBreedte, CbxGebruiksfunctie, TbxHoogte, TbxBouwLaag, TbxGO), dienen de waarden geupdate / opgeslagen worden in sheet "AutoCAD data" in desbetreffende kolom/regel achter de juiste Ruimtenummer (combobox1). De overige velden dienen geupdate te worden in sheet "Algemeen" achter de juiste ruimtenummer (Combobox1)..
- Ik heb de code om de GO uit te rekenen toegepast, echter na het invullen van TbxLengte en Tbxbreedte wordt de TbxGO niet uitgerekend (in de Userform).
- Ik zou nog ook graag de lege regels weg willen hebben uit CbxType1.
- "With Blad8" Wat houdt Blad 8 in? Is dit een bepaald sheet?

Mvg

Roy
 
Laatst bewerkt:
Blad8 is hetzelfde als Sheets("AutoCAD Data")
Om de lege cellen uit combobox te krijgen moet je iets in de dictionary veranderen maar hoe dat weet ik ook niet :eek:
 

Bijlagen

  • TestTemplate.xlsb
    87,9 KB · Weergaven: 48
De tabel in het blad 'verlichting' is niet goed gevuld. Dit geeft dan lege regels in de comboboxen. Dit is met code wel vrij eenvoudig te ondervangen maar je kan er beter voor zorgen dat de basis goed is.
 
Ik had met lege regels opgebouwd, zodat een extra verlichting toegevoegd kon worden. Ik had dit in eerste instantie met gedefinieerde namen gedaan zoals met range gloeilamp, Led etc. Dacht dat net vba code de lege regels kon ontwijken.

Heb je tips hoe ik de basis wel goed kan opbouwen?
 
Laatst bewerkt:
Beste Jack,

Bedankt voor de codes. Het werkt bijna goed.

- Bij TbxGO en TbxHoogte moet ik 2 decimalen hebben. Evenals in AutoCAD Data sheet als Algemeen bij GO.
- Indien TbxHoogte wordt gewijzigd, Wordt dit fout weggeschreven (komt in kolom van GO) en wordt bij kolom Hoogte een #N/B waarde.
- Ik krijg een Fout 13 tijdens uitvoering (Typen komen niet overeen). Bij foutopsporing wordt dit verwezen naar Sub Bereken. Dit heeft (waarschijnlijk) te maken doordat TbxGO al een waarde heeft en TbxLengte en TbxBreedte leeg is in AutoCAD data sheet. In principe als TbxGO een waarde heeft, dan mag TbxLengte en -Breedte genegeerd worden.
Ik heb dit opgelost met (weet niet of dit goed is):
Code: 
Sub bereken()
  If Me.TbxGO.Value <> "" And CDbl(TbxLengte.Value) = "" And (TbxBreedte.Value) = "" Then
  ElseIf Me.TbxGO.Value = "" And CDbl(TbxLengte.Value) <> "" And (TbxBreedte.Value) <> "" Then
  Me.TbxGO.Value = CDbl(Me.TbxLengte.Value * Me.TbxBreedte.Value)
  End If
End Sub

- Hoe zou ik een extra ruimtenummer in Combobox1 kunnen creeren? Moet hiervoor een extra textbox met ruimtenummer gemaakt worden?
- Ik zou tevens ook een samenvatting willen hebben van de verlichting. Het is zoiets als bv. (Sommen.ALS(TLD & 1x18) = xxx en dan voor alle soorten en typen die in de tabellen voorkomt (sheet Algemeen).
* De code zou alle unieke waarden moeten zoeken in CbxSoort1 (kolom O), CbxSoort2 (kolom X), CbxSoort3 (kolom AG). Bijvoorbeeld, Gloeilamp, LED etc.
* Vervolgens de unieke waarden in CbxType1, CbxType2, CbxType3 die bij Gloeilamp, LED etc. behoren (zie sheet Verlichting).
* Vervolgens de totale waarden van deze unieke typen (de totale waarden staan in kolommen S-AB-AK).

Alvast bedankt.

Mvg

Roy
 
Kijk eens of je met deze code je gegevens wel goed geplaatst worden.
Code: 
Sub bereken()
  If IsNumeric(TbxLengte) And IsNumeric(TbxBreedte) Or Not IsNumeric(TbxGO) Then
     Me.TbxGO.Value = Format(TbxLengte.Value * TbxBreedte.Value, "0.00")
  End If
End Sub
 
Beste Jack,

Ik krijg nu wel 2 decimalen te zien, indien ik TbxGO wordt berekend. Ik zou graag standaard 2 decimalen willen hebben ook als ik de ruimtenummer wijzig in Combobox1.
Hoe krijg ik dit voor elkaar?

Mvg

Roy.

P.s. nog een fijne jaarwisseling.
 
Dit stukje even aanpassen
Code: 
Private Sub ComboBox1_Change()
  With Sheets("AutoCAD Data")
    j = .Columns(1).Find(ComboBox1, , , xlWhole).Row
      TbxBouwLaag = .Cells(j, 2).Value
      CbxGebruiksfunctie = .Cells(j, 4).Value
      TbxGO = Format(.Cells(j, 5), "0.00")
      TbxHoogte = Format(.Cells(j, 6), "0.00")
      TbxLengte = Format(.Cells(j, 14), "0.00")
      TbxBreedte = Format(.Cells(j, 15), "0.00")
  End With
 
Beste,

De beste wensen allemaal.

@ Jack, bedankt voor de code wederom. De decimalen is gelukt.

Ik heb de volgende code nog uitgeprobeerd:
Code: 
Sub bereken()
  If IsNumeric(TbxLengte) And IsNumeric(TbxBreedte) Or Not IsNumeric(TbxGO) Then
     Me.TbxGO.Value = Format(TbxLengte.Value * TbxBreedte.Value, "0.00")
  End If
End Sub

Dit gaat wel goed, echter krijg ik een foutmelding indien TbxGO gevuld is en TbxLengte en TbxBreedte leeg is.

Ik heb dit geprobeerd op te lossen met:
Code: 
Sub bereken()

  If IsNumeric(TbxLengte) And IsNumeric(TbxBreedte) And IsNumeric(TbxGO) Then
           Me.TbxGO.Value = (TbxLengte.Value * TbxBreedte.Value)
    End If
    
     If IsNumeric(TbxLengte) And IsNumeric(TbxBreedte) And Not IsNumeric(TbxGO) Then
             Me.TbxGO.Value = (TbxLengte.Value * TbxBreedte.Value)
    End If
 
End Sub

Vraag me af dit wel goed geschreven is.

Mvg

Roy.
 
Laatst bewerkt:
Waarom zou er in tbxG0 tekst staan als er een berekening in plaats moet vinden?

Code: 
[COLOR=#3E3E3E]Sub bereken()[/COLOR]  
 TbxGO = ""
 If IsNumeric(TbxLengte) And IsNumeric(TbxBreedte) Then TbxGO = format(TbxLengte * TbxBreedte,"0.00")
End Sub
 
Beste HSV,

Bedankt voor de code.
1 nadeel van dit code is, indien al een waarde staat in TbxGO in sheet AutoCAD data, dan wordt deze gewist in de Userform door TbxGO = "".
De code moet de TbxGO in tact laten, indien dit al ingevuld is. Alleen indien ik TbxLengte en - breedte invul, moet TbxGO opnieuw berekent worden.

Hierbij mijn laatste versie.

Bekijk bijlage TestTemplate (1).xlsb

Ik ben tevens ook bezig om een samenvatting te krijgen van de verlichting1, 2 en 3.

* De code zou alle unieke waarden moeten zoeken in CbxSoort1 (kolom O), CbxSoort2 (kolom X), CbxSoort3 (kolom AG). Bijvoorbeeld, Gloeilamp, LED etc.
* Vervolgens de unieke waarden in CbxType1, CbxType2, CbxType3 die bij Gloeilamp, LED etc. behoren (zie sheet Verlichting).
* Vervolgens de totale waarden van deze unieke typen (de totale waarden staan in kolommen S-AB-AK).

Je hebt onlangs deze code gegeven, echter krijg ik dit niet werkend:

Code: 
Sub hsv()
Dim sv, a, b(3), i As Long, obj1 as object, obj2 as object, obj3 As Object
Set obj1 = CreateObject("scripting.dictionary")
Set obj2 = CreateObject("scripting.dictionary")
Set obj3 = CreateObject("scripting.dictionary")
With Blad2
 sv = .Range("E4:V60")
     For i = 1 To UBound(sv)
      With Choose(sv(i, 1), obj1, obj2, obj3)
      
        If sv(i, 2) <> "" Then
          a = .Item(sv(i, 1) & sv(i, 2) & sv(i, 3))
               If IsEmpty(a) Then a = b
                 a(0) = sv(i, 1)
                 a(1) = sv(i, 2)
                 a(2) = sv(i, 3)
                 a(3) = a(3) + IIf(sv(i, 6) = "", 0, sv(i, 6))
                 .Item(sv(i, 1) & sv(i, 2) & sv(i, 3)) = a
          End If
        
        If sv(i, 8) <> "" Then
             a = .Item(sv(i, 1) & sv(i, 8) & sv(i, 9))
               If IsEmpty(a) Then a = b
                 a(0) = sv(i, 1)
                 a(1) = sv(i, 8)
                 a(2) = sv(i, 9)
                 a(3) = a(3) + IIf(sv(i, 12) = "", 0, sv(i, 12))
                .Item(sv(i, 1) & sv(i, 8) & sv(i, 9)) = a
            End If
        
        If sv(i, 14) <> "" Then
             a = .Item(sv(i, 1) & sv(i, 14) & sv(i, 15))
               If IsEmpty(a) Then a = b
                 a(0) = sv(i, 1)
                 a(1) = sv(i, 14)
                 a(2) = sv(i, 15)
                 a(3) = a(3) + IIf(sv(i, 18) = "", 0, sv(i, 18))
                .Item(sv(i, 1) & sv(i, 14) & sv(i, 15)) = a
             End If
        End With
      Next i
  .Cells(85, 6).Resize(obj1.Count, 4) = Application.Index(obj1.items, 0, 0)
  .Cells(85, 12).Resize(obj2.Count, 4) = Application.Index(obj2.items, 0, 0)
  .Cells(85, 18).Resize(obj3.Count, 4) = Application.Index(obj3.items, 0, 0)
 End With
 End Sub

Ik was bezig om dit via VBA Draaitabellen (code staat in ThisWorkbook) te krijgen echter kom ik hier niet verder mee.
Nadeel van draaitabellen is, dat ik een hele tabel moet selecteren (of een gedeelte). Ik kan niet bijvoorbeeld kolom E-G, J-K en N-P selecteren mbv Draaitabel.

Hoe krijg ik deze code werkend?
Groeten,

Roy
 
Ik blijf eerst maar even bij deze vraag.
Code: 
Sub bereken()  
 TbxGO.tag = TbxGO.value
  If IsNumeric(TbxLengte) And IsNumeric(TbxBreedte) Then 
    TbxGO = format(TbxLengte * TbxBreedte,"0.00")
 else
  TbxGO = TbxGO.tag
end if
End Sub

Op de andere code in die andere vraag heb ik nauwelijks een reactie gehad.
Volgens mij loop je te hard van stapel.
Eerst het ene, dan het ander.
 
Haha. Ben al een paar weken mee bezig met dit formulier en wil het nu een beetje afronden. Thanks voor de code zal dit weer testen.

De andere vraag had ik afgesloten en ben met deze weer verder gegaan, omdat de code bij deze Userform toegepast moet worden.

Mvg
Roy
 
Laatst bewerkt:
Test het eerst en laat dan een reactie achter.
Jij werkt andersom; je bedankt me voor de ongeteste code en ik verneem in een andere vraag dat je het niet werkend krijgt.
Daar wordt geen mens wijs uit.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan