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


usfIndex


Private Sub cboWerkstoffName_Change()

    Me.cboWerkstoffNr = Tabelle1.Cells(Me.cboWerkstoffName.ListIndex + 2, 1)
   
End Sub

Private Sub cboWerkstoffNr_Change()

    Me.cboWerkstoffName = Tabelle1.Cells(Me.cboWerkstoffNr.ListIndex + 2, 2)
   
End Sub

Private Sub cmdBerechnen_Click()

Dim lngZeile As Single
    lngZeile = 2
   
        If Me.cboWerkstoffNr = "" And Me.cboWerkstoffName = "" Then                      'Sobald die cboWerkstoffNr und die cboWerkstoffName leer sind...
            MsgBox ("Bitte geben Sie eine Werkstoffnummer oder den Werkstoff Namen an!" '...wird eine Messagebox ausgegeben.
        ElseIf Me.txtVolumen = "" Then                                                     'Sobald das txtVolumen Leer ist,...
            MsgBox ("Bitte geben Sie das Volumen an!"                                   '...wird eine Messagebox ausgegeben.
        ElseIf Me.txtVolumen = "" Then                                                   'Sobald das txtVolumen leer ist,...
            MsgBox ("Bitte geben Sie das Volumen an !"                                  '...wird eine Messagebox ausgegeben.
        Else
            Me.txtGewicht = Val(Replace(Replace(Me.txtVolumen, ".", "", ",", ".") * (Tabelle1.Cells(lngZeile, 4) / 1000)
        End If
       
        Do
            If Tabelle3.Cells(lngZeile, 1) = "" Then
                Tabelle3.Cells(lngZeile, 1) = usfIndex.cboWerkstoffNr
                Tabelle3.Cells(lngZeile, 2) = usfIndex.cboWerkstoffName
                Tabelle3.Cells(lngZeile, 3) = usfVolumen.txtParameter1
                Tabelle3.Cells(lngZeile, 4) = usfVolumen.txtParameter2
                Tabelle3.Cells(lngZeile, 5) = usfVolumen.txtParameter3
                Tabelle3.Cells(lngZeile, 6) = usfVolumen.txtParameter4
                Tabelle3.Cells(lngZeile, 7) = usfVolumen.txtParameter5
                Tabelle3.Cells(lngZeile, 8) = usfIndex.txtVolumen
                Tabelle3.Cells(lngZeile, 9) = usfIndex.txtGewicht
        Exit Do
            Else
                Tabelle3.Range("A2".EntireRow.Insert
            End If
        Loop
End Sub

Private Sub cmdEnde_Click()
   
    End 'Beendet das Programm
   
End Sub

Private Sub cmdGeometrie_Click()
   
    usfIndex.Hide   'setzt die Aktuelle Userform in den Hintergrund und...
    usfVolumen.Show '...öffnet die Userform Volumen
   
End Sub

Private Sub txtGewicht_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    Me.txtGewicht = Format(Me.txtGewicht, "#,##.00"
   
End Sub

Private Sub txtVolumen_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    Me.txtVolumen = Format(Me.txtVolumen, "#,##0.00"
   
End Sub

Private Sub UserForm_Activate()

    Dim lngZeile As Long                                                'Hier erfolgt die Dimensionierung von Lng Zeile As Long
        lngZeile = 2

        Do
            If Tabelle1.Cells(lngZeile, 1) = "" Then                    'Sobald er eine Leere Zeile in dem Tabellenblatt1 spalte 1 sieht soll er die Schleife schließen.
           
        Exit Do
            Else
                Me.cboWerkstoffNr.AddItem Tabelle1.Cells(lngZeile, 1)   'Speichert die Daten in der Ersten Spalte in die cbo WerkstoffNr sodass alle aktuell in der Userform erfassten Daten aufgeführt sind.
                Me.cboWerkstoffName.AddItem Tabelle1.Cells(lngZeile, 2) 'Speichert die aktuellen Daten in der Zweiten Spalte in die cbo WerkstoffName, sodass alle aktuellen Daten aus der Excel tabelle erfasst sind.
                lngZeile = lngZeile + 1
               
            End If
        Loop
End Sub


16.5.16 07:13


 [eine Seite weiter]



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