Ich bin absoluter Anfänger was VBA-Programmierung betrifft. Alleridinsg soll ich eine Tool entwickeln
In diesem soll eine neue Datei erstellt werden. Darin sollen neun Diagramme erstellt werden. Die Daten kommen aus verschiedenen anderen bestehenden Excel-Dateien. Es geht um Schallmessversuche bei verschiedenen Frequenzen. Die Diagramme sollen dann für Mikrofon 1 bis Mikrofon 9 gelten in denen jeweils pro Versuch eine Kurve enstehen soll (Maximal 5 Versuchem = 5 Kurven in einem Diagramm).
So sieht mein Tool momentan aus.
Mit dem ersten Button soll die neue Datei erstellt werden.
Sub NeueDateiSpeichernUnter()
Dim datei As String
Dim Verzeichnis As String
Dim SaveDummy As Variant
Verzeichnis = "C:\temp\" 'Verzeichnis-Vorschlag
datei = Range("B9") & ".xls" 'Datei-Vorschlag
Workbooks.Add 'Neue Datei anwählen
SaveDummy = SpeichernUnter(Verzeichnis & datei)
'Es wurde auf Speichern gedrückt
If SaveDummy <> False Then ActiveWorkbook.SaveAs SaveDummy
ActiveWorkbook.Close
End Sub
Mit dem zweiten Button folgt die Öffnung der Messdateien und der neu erstellten Datei.
Sub DateienOeffnen()
'#####Erstellte Datei für Vergleich der Schallmessungen#####'
Workbooks("Erstellung_Vergleich_Schallmessungen.xlsm").Activate
Workbooks.Open Filename:=Range("B9")
'#####Dateien der Raumschall-Messversuche öffnen#####'
'Raumschallmessung Datei 1
Workbooks("Erstellung_Vergleich_Schallmessungen.xlsm").Activate
If Range("B13").Value = "" Then
GoTo EndeDatei1 'wenn Zelle B13 leer -> Prozedur beenden
Else
Workbooks.Open Filename:=Range("B13")
End If
EndeDatei1:
'Raumschallmessung Datei 2
Workbooks("Erstellung_Vergleich_Schallmessungen.xlsm").Activate
If Range("B15").Value = "" Then
GoTo EndeDatei2 'wenn Zelle B15 leer -> Prozedur beenden
Else
Workbooks.Open Filename:=Range("B15")
End If
EndeDatei2:
'Raumschallmessung Datei 3
Workbooks("Erstellung_Vergleich_Schallmessungen.xlsm").Activate
If Range("B17").Value = "" Then
GoTo EndeDatei3 'wenn Zelle B17 leer -> Prozedur beenden
Else
Workbooks.Open Filename:=Range("B17")
End If
EndeDatei3:
'Raumschallmessung Datei 4
Workbooks("Erstellung_Vergleich_Schallmessungen.xlsm").Activate
If Range("B19").Value = "" Then
GoTo EndeDatei4 'wenn Zelle B19 leer -> Prozedur beenden
Else
Workbooks.Open Filename:=Range("B19")
End If
EndeDatei4:
'Raumschallmessung Datei 5
Workbooks("Erstellung_Vergleich_Schallmessungen.xlsm").Activate
If Range("B21").Value = "" Then
GoTo EndeDatei5 'wenn Zelle B21 leer -> Prozedur beenden
Else
Workbooks.Open Filename:=Range("B21")
End If
EndeDatei5:
End Sub
Die Excel-Dateien zu den Schallmessversuchen (Vers_23_11_a_.xls) usw. besitzen jeweils vier Reiter. Der zweite lautet dB(A) und ist der benötigt wird.
Nun weiß ich nicht, wie ich davon die Diagramme erstellen kann. Ich hänge schon so lange daran und kapiere es nicht.
Kann mr jemand helfen.
Das ist bisher alles was ich für die Prozedur zu den Diagrammen habe. Vermutlich muss man es aber komplett umschreiben.
Sub DiagrammErstellen()
Dim PfadNeueDatei As String 'Variable für Pfad der neu erstellten Datei
Dim Pfad1 As String 'Variable für Mess-Datei1
Dim Diagramm1 As Chart 'Variable für Diagramm CH
Dim Rahmen1 As ChartObject 'Variable für Rahmen CO
PfadNeueDatei = Cells(9, 2).Value
Workbooks(PfadNeueDatei).Activate
Set Rahmen1 = ActiveWorkbook.Worksheets(1).ChartObjects.Add(0, 0, 400, 250)
Set Diagramm1 = Rahmen1.Chart
Diagramm1.ChartType = xlXYScatterLines
Workbooks("Erstellung_Vergleich_Schallmessungen.xlsm").Activate
Pfad1 = Cells(14, 2).Value
Workbooks(Pfad1).Activate
|