Thema Datum  Von Nutzer Rating
Antwort
Rot Diagramme in anderer Mappe, Daten aus anderen Dateien
01.02.2019 14:08:30 Marcel
NotSolved
01.02.2019 23:18:02 Gast49761
NotSolved
01.02.2019 23:18:11 Gast62861
NotSolved
01.02.2019 23:18:11 Gast3645
NotSolved
03.02.2019 17:39:59 Gast31186
NotSolved
04.02.2019 00:46:04 Gast58039
NotSolved
05.02.2019 08:43:30 Marcel
NotSolved
05.02.2019 10:18:38 Gast81619
NotSolved
09.02.2019 18:56:13 Marcel
NotSolved
10.02.2019 04:10:28 Ulrich
NotSolved

Ansicht des Beitrags:
Von:
Marcel
Datum:
01.02.2019 14:08:30
Views:
766
Rating: Antwort:
  Ja
Thema:
Diagramme in anderer Mappe, Daten aus anderen Dateien

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

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Diagramme in anderer Mappe, Daten aus anderen Dateien
01.02.2019 14:08:30 Marcel
NotSolved
01.02.2019 23:18:02 Gast49761
NotSolved
01.02.2019 23:18:11 Gast62861
NotSolved
01.02.2019 23:18:11 Gast3645
NotSolved
03.02.2019 17:39:59 Gast31186
NotSolved
04.02.2019 00:46:04 Gast58039
NotSolved
05.02.2019 08:43:30 Marcel
NotSolved
05.02.2019 10:18:38 Gast81619
NotSolved
09.02.2019 18:56:13 Marcel
NotSolved
10.02.2019 04:10:28 Ulrich
NotSolved