UserForm aanpassen en updaten in Sheets mbv VBA

Status
Niet open voor verdere reacties.
Het hele proces is een wirwar aan codes.
Ik ga dat niet helemaal voor je optimaliseren.

Een stukje om je op gang te helpen.
Code: 
Private Sub ComboBox1_Change()


  With Sheets("AutoCAD Data")
   Set c = .Columns(1).Find(ComboBox1, , , xlWhole)
    If Not c Is Nothing Then
      TbxBouwLaag = c.Offset(1).Value
      TbxGO = Format(c.Offset(, 4), ".00")
      TbxHoogte = Format(c.Offset(, 5), "0.00")
      TbxLengte = Format(c.Offset(, 13), "0.00")
      TbxBreedte = Format(c.Offset(, 14), "0.00")
      CbxGebruiksfunctie = c.Offset(, 3).Value
     End If
  End With
    
bereken

Zorg dat de codes die daar op volgen aangepast worden zodat je met de Update-knop alles wegschrijft.
 
Ik heb toch een aparte Userform voor gemaakt en op de Ribbon geplaatst mbv IRibbonControl.

Heb hier de volgende code voor gebruikt (en werkt op zich prima) en kan daarna via Userform deze ruimtenummers benaderen.

Code: 
Private Sub CbtVoeg_Click()
        
With Sheets("AutoCAD Data").Select
Range("A1").Select
    
    Do Until IsEmpty(ActiveCell.Value)
        ActiveCell.Offset(1, 0).Select
    Loop
    
    ActiveCell.Value = Me.TxtRuimteNr
    End With

    Unload Me
End Sub
 
Dit zal op den duur sneller gaan i.p.v. de loop.
Code: 
Private Sub CbtVoeg_Click()
With Sheets("AutoCAD Data")
  .cells(rows.count,1).end(xlup).offset(abs(.range("a1") >0)) = [COLOR=#3E3E3E]TxtRuimteNr[/COLOR]
End With
Unload Me
End Sub
 
Volgens mij heb ik nu alles wat ik moest hebben voor dit formulier.

Tot zo ver bedankt heren voor jullie medewerking.

Ik ga dit nog testen op een Ipad hopelijk zal dit wel goed werken.

Mocht ik nog wat vergeten zijn, dan laat ik dit wel weten.

Groeten,

Roy.
 
Laatst bewerkt:
Hoef je niet te testen op een Ipad. Werkt toch niet.
 
Harry,

Ik had die code ooit op een VBA cursus gehad.
Ik heb jouw code ook uitgeprobeerd en werkt ook prima en laat jouw code dan ook staan in de module (neem graag aan van mensen die er verstand van hebben :thumb:).

Nogmaals bedankt.

Groeten,
Roy
 
Oei. Werkt het wel op een Tablet of een ander klein ding?
Dit formulier is bedoeld om op locatie te inspecteren zodat met niet meer met een tekeningen hoeft rond te lopen en aantekeningen erop te maken.

Gr.
 
Zoek maar eens op het net naar.
Excel VBA on tablet.
 
Dat bedoel ik dus.
Je kan het zelf beter lezen dan dat wij het hier moeten overschrijven.
 
Bij het testen van de code kom ik nog een foutmelding tegen.

Code: 
Private Sub CbtOK_Click()
Application.EnableEvents = False
  With Sheets("Algemeen").listobjects("tabel2")
    .Range.Cells(ComboBox1.ListIndex + 2, 9) = TbxRemark
    .Range.Cells(ComboBox1.ListIndex + 2, 11).Resize(, 2) = Array(CbxGebouwdeel.Value, CbxEnergiesector.Value)
    .Range.Cells(ComboBox1.ListIndex + 2, 15).Resize(, 3) = Array(CbxSoort1.Value, CbxType1.Value, TbxAantal1.Value)
    .Range.Cells(ComboBox1.ListIndex + 2, 20).Resize(, 3) = Array(CbxRegeling1.Value, CbxDetectie1.Value, CbxAfgezogen1.Value)
    .Range.Cells(ComboBox1.ListIndex + 2, 24).Resize(, 3) = Array(CbxSoort2.Value, CbxType2.Value, TbxAantal2.Value)
    .Range.Cells(ComboBox1.ListIndex + 2, 29).Resize(, 3) = Array(CbxRegeling2.Value, CbxDetectie2.Value, CbxAfgezogen2.Value)
    .Range.Cells(ComboBox1.ListIndex + 2, 33).Resize(, 3) = Array(CbxSoort3.Value, CbxType3.Value, TbxAantal3.Value)
    .Range.Cells(ComboBox1.ListIndex + 2, 38).Resize(, 3) = Array(CbxRegeling3.Value, CbxDetectie3.Value, CbxAfgezogen3.Value)
    .Range.Cells(ComboBox1.ListIndex + 2, 42).Resize(, 2) = Array(CbxVent1.Value, CbxVent2.Value)
  End With
      
 
    With Sheets("AutoCAD Data")
      .Cells(ComboBox1.ListIndex + 2, 2) = TbxBouwLaag.Value
      .Cells(ComboBox1.ListIndex + 2, 4).Resize(, 3) = Array(CbxGebruiksfunctie.Value, CDbl(TbxGO.Value), CDbl(TbxHoogte.Value))
      .Cells(ComboBox1.ListIndex + 2, 14).Resize(, 2) = Array(Format(TbxLengte.Value, ".00"), Format(TbxBreedte.Value, ".00"))
    End With

  MsgBox "Update voltooid"
Application.EnableEvents = True
End Sub

Indien tbxGO gevuld is, mag de update wel uitgevoerd worden.
Indien tbxGO leeg is en TbxLengte of TbxBreedte leeg is, dan moet er een melding komen dat Breedte of Lengte leeg is en deze alsnog ingevuld dient te worden.

Wat moet er aangepast worden?

Mvg
 
Laatst bewerkt door een moderator:
Die vraag heb je in deze topic al gesteld en is ook beantwoord.
 
Gaat het om deze code:

Code: 
  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
 
Nee, eerder in de buurt van #18.
Beetje inleven in code en je komt er zelf wel uit dacht ik zo.
 
Harry,

Ik heb deze code ook uitgeprobeerd onder Update

Code: 
TbxGO.tag = TbxGO.value
  If IsNumeric(TbxLengte) And IsNumeric(TbxBreedte) Then 
    TbxGO = format(TbxLengte * TbxBreedte,"0.00")
 else
  TbxGO = TbxGO.tag
end if

Echter kreeg ik wat foutmeldingen bij .Cell..... Kreeg de foutmelding indien tbxGO en tbxLengte leeg was en tbxBreedte een waarde had.

Zal anders nogmaals uitproberen.

Mvg
 
Harry,

Het is mij aardig gelukt.

Code: 
   TbxGO.Tag = TbxGO.Value
  If Not IsNumeric(TbxLengte) Or Not IsNumeric(TbxBreedte) Then
      TbxGO = TbxGO.Value
 Else
   If TbxLengte = "" Or TbxBreedte = "" And TbxGO = "" Then
    TbxGO = "0.00"
    Else
    TbxGO = CDbl(TbxLengte * TbxBreedte)
End If
End If

 
    With Sheets("AutoCAD Data")
      .Cells(ComboBox1.ListIndex + 2, 2) = TbxBouwLaag.Value
      .Cells(ComboBox1.ListIndex + 2, 4) = CbxGebruiksfunctie.Value
      .Cells(ComboBox1.ListIndex + 2, 6) = TbxHoogte.Value
      .Cells(ComboBox1.ListIndex + 2, 5) = Format(TbxGO.Value, ".00")
      .Cells(ComboBox1.ListIndex + 2, 14) = CDbl(TbxLengte.Value)
      .Cells(ComboBox1.ListIndex + 2, 15) = CDbl(TbxBreedte.Value)
      '.Cells(ComboBox1.ListIndex + 2, 14).Resize(, 2) = Array(CDbl(TbxLengte.Value), CDbl(TbxBreedte.Value))
    End With

Echter heb ik wel problemen indien er velden leeg zijn. Indien ik CDbl gebruik en de velden zijn leeg, krijg ik een melding dat de typen niet overeenkomen. DIt moet ik dan wijzigen in Format(....., ".00").

Op zich is dit geen probleem, echter wordt de celeigenschap anders in Excel. KRijg dan een opmerking in de cel (groene driehoek linksboven) dat het getal opgeslagen is als tekst. Heb dan de optie om dit naar een getal te converteren.

Ik zou dit graag vanuit VBA al geregeld willen hebben, zodat ik achteraf geen handwerk meer heb.
 
Maak gebruik van Exit sub indien niet aan een voorwaarde is voldaan.

If not isnumeric(...) and not isnumeric(....) then exit sub.
 
Harry,
Als ik Exit Sub erachter toevoeg, dan kan ik niet updaten totdat de velden staan ingevuld.
Mocht het aan 1 van die voorwaarden niet voldoen (dus als TbxBreedte of TbxLengte leeg is), dan krijg ik foutmelding bij CDbl... (typen komen niet overeen).

Voor alle duidelijkheid. De code staat onder " Private Sub CbtOK_Click()"
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan