title image


Smiley Bin ein Stück weiter jetzt muß ich nur noch wissen.....
wie ich das Macro am Ende meines bisherigen Quelltextes Aufrufe. Hab das Makro hinter den Kommentar: 'Chart einfügen geschrieben, läuft aber nicht!



Private Sub CommandButton1_Click()

On Error GoTo Fehler

Dim oApp As Object

Dim rs As DAO.Recordset, i As Long, xlWs As Object, xlWb As Object

Dim AktZeile As Variant

Dim x As Variant

Dim X1 As Variant

Dim X2 As Variant

Dim X3 As Date

Dim X4 As Variant

Dim X5 As Double

Dim lZeile As Long

Dim Zähler As Long

Dim Wert_0 As Double

Dim Wert_1 As Double

Dim Wert_2 As Double

Dim Wert_3 As Double

Dim GesSumme_0 As Double

Dim GesSumme_1 As Double

Dim GesSumme_2 As Double

Dim GesSumme_3 As Double

Set oApp = CreateObject("Excel.Application")

Set xlWb = oApp.Workbooks.Open("g:\Wartung\Verfügbarkeit_Sägewerk1\" & TextBox1 & ".xls")

Set xlWs = xlWb.Worksheets(TextBox1.Text)

oApp.Visible = True

xlWs.Select



xlWs.Cells(1, 6) = "Berechnung"

xlWs.Cells(1, 7) = "läuft"

oApp.Worksheets.MsgBox("lksamdc").Show

x = 1

AktZeile = 1

X5 = 0.33

Do Until x = ""

' String zerlegen

x = oApp.Worksheets(TextBox1.Text).Cells(AktZeile, 1)

X1 = Left(x, 20)

oApp.Worksheets(TextBox1.Text).Cells(AktZeile, 2) = X1

X2 = Mid(x, 28, 1)

oApp.Worksheets(TextBox1.Text).Cells(AktZeile, 1) = X2

X3 = (Mid(x, 30, 10))

oApp.Worksheets(TextBox1.Text).Cells(AktZeile, 3) = X3

X4 = Mid(x, 41, 8)

oApp.Worksheets(TextBox1.Text).Cells(AktZeile, 4) = X4

oApp.Worksheets(TextBox1.Text).Cells(AktZeile, 5) = X5

AktZeile = AktZeile + 1

Loop



'Daten sortieren

xlWs.Select



xlWs.Columns("A:A").Insert Shift:=xlToRight

For lZeile = 1 To xlWs.Range("F65536").End(xlUp).Row

xlWs.Range("A" & lZeile).Value = xlWs.Range("B" & lZeile).Value

Next lZeile

xlWs.Range("A1:F" & xlWs.Range("A65536").End(xlUp).Row).Sort _

Key1:=xlWs.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

xlWs.Columns("A:A").Delete Shift:=xlToLeft



'Summen bilden

Zähler = 1

Wert_0 = 0

Wert_1 = 0

Wert_2 = 0

Wert_3 = 0

For Zähler = 1 To xlWs.Range("A65536").End(xlUp).Row

If xlWs.Cells(Zähler, 1) = 0 Then

Wert_0 = xlWs.Cells(Zähler, 5)

GesSumme_0 = GesSumme_0 + Wert_0

End If

If xlWs.Cells(Zähler, 1) = 1 Then

Wert_1 = xlWs.Cells(Zähler, 5)

GesSumme_1 = GesSumme_1 + Wert_1

End If

If xlWs.Cells(Zähler, 1) = 2 Then

Wert_2 = xlWs.Cells(Zähler, 5)

GesSumme_2 = GesSumme_2 + Wert_2

End If

If xlWs.Cells(Zähler, 1) = 3 Then

Wert_3 = xlWs.Cells(Zähler, 5)

GesSumme_3 = GesSumme_3 + Wert_3

End If



'Summen eintragen



Next

xlWs.Cells(1, 6) = "Berechnung"

xlWs.Cells(1, 7) = "beendet"

xlWs.Cells(1, 8) = "Laufzeit gesammt:"

xlWs.Cells(1, 9) = GesSumme_0

xlWs.Cells(2, 8) = "Stillstand gesammt"

xlWs.Cells(2, 9) = GesSumme_1

xlWs.Cells(3, 8) = "Keine Kommunikation gesammt"

xlWs.Cells(3, 9) = GesSumme_2

xlWs.Cells(4, 8) = "Störung"

xlWs.Cells(4, 9) = GesSumme_3

xlWs.Cells(1, 10) = "Minuten"

xlWs.Cells(2, 10) = "Minuten"

xlWs.Cells(3, 10) = "Minuten"

xlWs.Cells(4, 10) = "Minuten"



'Chart einfügen



Charts.Add

xlWs.ChartType = xl3DPie

xlWs.SeriesCollection.NewSeries

xlWs.SeriesCollection(1).XValues = "='oApp.Worksheets(TextBox1.Text)'!R1C8:R4C8"

xlWs.SeriesCollection(1).Values = "='oApp.Worksheets(TextBox1.Text)'!R1C9:R4C9"

xlWs.Location xlLocationAsObject, Name:="oApp.Worksheets(TextBox1.Text)"

xlWs.HasTitle = False

xlWs.Visible = False

Windows("oApp.Worksheets(TextBox1.Text)").Activate



Exit Sub



Fehler:

Resume Next

End Sub



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: