Startseite
  Über...
  Archiv
  Gästebuch
  Kontakt
 

  Abonnieren
 



  Letztes Feedback



http://myblog.de/netline

Gratis bloggen bei
myblog.de





usfVolumen

Private Sub cboGeometrie_Change()

    If Me.cboGeometrie.Text = "Rund Vollmaterial" Then
        Me.lblmm1.Visible = True
        Me.lblmm2.Visible = True
        Me.lblmm3.Visible = False
        Me.lblmm4.Visible = False
        Me.lblmm5.Visible = False
        
        Me.lblParameter1.Visible = True
        Me.lblParameter2.Visible = True
        Me.lblParameter3.Visible = False
        Me.lblParameter4.Visible = False
        Me.lblParameter5.Visible = False
        
        Me.lblParameter1.Caption = "Durchmesser"
        Me.lblParameter2.Caption = "Länge"
        
        Me.txtParameter1.Visible = True
        Me.txtParameter2.Visible = True
        Me.txtParameter3.Visible = False
        Me.txtParameter4.Visible = False
        Me.txtParameter5.Visible = False
        
        Me.cmdUebernehmen.Visible = True
        Me.cmdZurueck.Visible = True
        
    ElseIf Me.cboGeometrie.Text = "Rund Rohr" Then
        Me.lblmm1.Visible = True
        Me.lblmm2.Visible = True
        Me.lblmm3.Visible = True
        Me.lblmm4.Visible = False
        Me.lblmm5.Visible = False
        
        Me.lblParameter1.Visible = True
        Me.lblParameter2.Visible = True
        Me.lblParameter3.Visible = True
        Me.lblParameter4.Visible = False
        Me.lblParameter5.Visible = False
        
        Me.lblParameter1.Caption = "Durchmesser außen"
        Me.lblParameter2.Caption = "Durchmesser innen"
        Me.lblParameter3.Caption = "Länge"
        
        Me.txtParameter1.Visible = True
        Me.txtParameter2.Visible = True
        Me.txtParameter3.Visible = True
        Me.txtParameter4.Visible = False
        Me.txtParameter5.Visible = False
        
        Me.cmdUebernehmen.Visible = True
        Me.cmdZurueck.Visible = True
        
    ElseIf Me.cboGeometrie.Text = "Viereck Vollmaterial" Then
        Me.lblmm1.Visible = True
        Me.lblmm2.Visible = True
        Me.lblmm3.Visible = True
        Me.lblmm4.Visible = False
        Me.lblmm5.Visible = False
        
        Me.lblParameter1.Visible = True
        Me.lblParameter2.Visible = True
        Me.lblParameter3.Visible = True
        Me.lblParameter4.Visible = False
        Me.lblParameter5.Visible = False
        
        Me.lblParameter1.Caption = "Kantenlänge außen a"
        Me.lblParameter2.Caption = "Kantenlänge außen b"
        Me.lblParameter3.Caption = "Länge"
        
        Me.txtParameter1.Visible = True
        Me.txtParameter2.Visible = True
        Me.txtParameter3.Visible = True
        Me.txtParameter4.Visible = False
        Me.txtParameter5.Visible = False
        
        Me.cmdUebernehmen.Visible = True
        Me.cmdZurueck.Visible = True
        
    Else
        Me.cboGeometrie.Text = "Viereck Rohr"
        Me.lblmm1.Visible = True
        Me.lblmm2.Visible = True
        Me.lblmm3.Visible = True
        Me.lblmm4.Visible = True
        Me.lblmm5.Visible = True
        
        Me.lblParameter1.Visible = True
        Me.lblParameter2.Visible = True
        Me.lblParameter3.Visible = True
        Me.lblParameter4.Visible = True
        Me.lblParameter5.Visible = True
        
        Me.lblParameter1.Caption = "Kantenlänge außen a"
        Me.lblParameter2.Caption = "Kantenlänge innen a"
        Me.lblParameter3.Caption = "Kantenlänge außen b"
        Me.lblParameter4.Caption = "Kantenlänge innen b"
        Me.lblParameter5.Caption = "Länge"
        
        Me.txtParameter1.Visible = True
        Me.txtParameter2.Visible = True
        Me.txtParameter3.Visible = True
        Me.txtParameter4.Visible = True
        Me.txtParameter5.Visible = True
        
        Me.cmdUebernehmen.Visible = True
        Me.cmdZurueck.Visible = True
    End If
    
End Sub

Private Sub cmdUebernehmen_Click()
    
    usfVolumen.Hide
    
        If usfVolumen.cboGeometrie.Text = "Rund Vollmaterial" Then                                                           'Wenn in der cboGeometrie der Text Rund Vollmaterial erscheint,...
            usfIndex.txtVolumen = ((((usfVolumen.txtParameter1 / 10) ^ 2) * Tabelle2.Cells(9, 1)) / 4) * (usfVolumen.txtParameter2 / 10) '...dann wird das Volumen des Runden Vollmaterials berechnet!
        ElseIf usfVolumen.cboGeometrie.Text = "Rund Rohr" Then
            usfIndex.txtVolumen = ((((usfVolumen.txtParameter1 / 10) ^ 2) / 4) - ((usfVolumen.txtParameter2 / 10) ^ 2) / 4) * Tabelle2.Cells(9, 1) * (usfVolumen.txtParameter3 / 10)
        ElseIf usfVolumen.cboGeometrie.Text = "Viereck Vollmaterial" Then
            usfIndex.txtVolumen = (usfVolumen.txtParameter1 / 10) * (usfVolumen.txtParameter2 / 10) * (usfVolumen.txtParameter3 / 10)
        Else
            usfVolumen.cboGeometrie.Text = "Viereck Rohr"
            usfIndex.txtVolumen = (((usfVolumen.txtParameter1 / 10) * (usfVolumen.txtParameter3 / 10)) - ((usfVolumen.txtParameter2 / 10) * (usfVolumen.txtParameter4 / 10))) * (usfVolumen.txtParameter5 / 10)
        End If

    usfIndex.Show

End Sub

Private Sub cmdZurueck_Click()

    usfVolumen.Hide  ' setzt die Aktuelle Userform in den Hintergrund und...
    usfIndex.Show '...öffnet die Userform Index
    
End Sub

Private Sub UserForm_Initialize()

    Dim lngZeile As Long
        lngZeile = 2
    
        Me.cboGeometrie.Visible = True
        Me.lblmm1.Visible = False
        Me.lblmm2.Visible = False
        Me.lblmm3.Visible = False
        Me.lblmm4.Visible = False
        Me.lblmm5.Visible = False
        
        Me.lblParameter1.Visible = False
        Me.lblParameter2.Visible = False
        Me.lblParameter3.Visible = False
        Me.lblParameter4.Visible = False
        Me.lblParameter5.Visible = False
        
        Me.txtParameter1.Visible = False
        Me.txtParameter2.Visible = False
        Me.txtParameter3.Visible = False
        Me.txtParameter4.Visible = False
        Me.txtParameter5.Visible = False
        
        Me.cmdUebernehmen.Visible = False
        Me.cmdZurueck.Visible = True
        
        Do
            If Tabelle2.Cells(lngZeile, 1) = "" Then
        Exit Do
            Else
                Me.cboGeometrie.AddItem Tabelle2.Cells(lngZeile, 1)
                lngZeile = lngZeile + 1
            End If
        Loop
End Sub

16.5.16 07:14
 


Werbung


bisher 0 Kommentar(e)     TrackBack-URL

Name:
Email:
Website:
E-Mail bei weiteren Kommentaren
Informationen speichern (Cookie)



 Smileys einfügen



Verantwortlich für die Inhalte ist der Autor. Dein kostenloses Blog bei myblog.de! Datenschutzerklärung
Werbung