VBA Excel Daten importieren Diagramme erstellen

Problem bei der Erstellung eines VBA scripts

Hallo Liebe Gemeinde

Ich bräuchte mal wieder eure Hilfe

ich brauche einen Code mit dessen Hilfe ich ein zweispaltiges .rtf Dokument (1.232;12.313) in Excel in einem neuen Tabellenblatt importiern und in einem Liniendiagramm wiedergeben kann.

Dass importiern einer .rtf datei hatte ich schonmal erfragt, also ist das nicht das Thema,
aber ein neues Tabellenblat mit einem diagramm erstellen hat sich für mich als etwas schwierig erwiesen.

Ich soll um die Hundert .rtf dateien händich in Excel importieren und diese dann in einem Diagramm grafich darstellen.
ich hab es auch soweit hinbekommen mit der importierung und der Auswertung in einem Diagramm, nur bei mir funktioniert es nur in einem Tabellenblatt.
Wenn ich versuche damit ein Zweites anzusteuern, hat er den Falschen Tabellenblattnamen drin und jenachdem auch einen falschen Diagrammnamen.
ich hoffe man kann mir helfen.

MFG
Broken

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 108177

Url: https://administrator.de/forum/vba-excel-daten-importieren-diagramme-erstellen-108177.html

Ausgedruckt am: 23.12.2024 um 19:12 Uhr

3 Kommentare

Neuester Kommentar

na dann zeige doch mal den source-code ausschnitt in welchem du das zweite tabellenblatt ansteuerst....

grüße
kruder

Moin

ich kann euch gerne mein Code zeigen

Sheets.Add
    Range("C3").Select  
    ChDir "\"  
    ChDrive "c:\"  
    'Dateiname = Application.GetOpenFilename("Micrsoft Alle-Dateien (*.*),*.*")  
    Dateiname = Application.GetOpenFilename("RTF-Dateien(*.rtf), *.rtf, Micrsoft Excel-Dateien (*.xls),*.xls, Textdateien (*.txt), *.txt,Alle Dateien (*.*),*.*")  
    If Dateiname = False Then Exit Sub
    MsgBox "Dateiname:" & vbNewLine & Dateiname  
    Range("A1").Select  
    Cells.Select
    Range("F29").Activate  
    Selection.ClearContents
    'Selection.QueryTable.Delete  
    zwichen = "TEXT;" + Dateiname  
    Range("A1").Select  
    With ActiveSheet.QueryTables.Add(Connection:=zwichen, Destination:=Range("A1"))  
         Destination:=Range("A1"))  
        .Name = "Waveform  2"  
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Range("D3").Select  
    Charts.Add
    ActiveChart.ChartType = xlLineMarkers
    ActiveChart.SetSourceData Source:=Sheets("Tabelle3").Range("A1:B2002"), _  
        PlotBy:=xlRows
    ActiveChart.SeriesCollection(1).XValues = "=Tabelle7!R1C1:R2002C1"  
    ActiveChart.SeriesCollection(1).Values = "=Tabelle7!R2C2:R2002C2"  
    ActiveChart.SeriesCollection(1).Name = "=Tabelle7!R1C2"  
    ActiveChart.Location Where:=xlLocationAsObject, Name:="Tabelle7"  
    With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = "1/22/2009"  
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Time [sec]"  
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Pressure [bar]"  
    End With
    ActiveChart.HasDataTable = False
    ActiveSheet.Shapes("Diagramm 1").IncrementLeft -81.75  
    ActiveSheet.Shapes("Diagramm 1").IncrementTop -138.75  
    ActiveChart.SeriesCollection(1).Select
    With Selection.Border
        .ColorIndex = 1
        .Weight = xlThick
        .LineStyle = xlContinuous
    End With
    With Selection
        .MarkerBackgroundColorIndex = xlAutomatic
        .MarkerForegroundColorIndex = xlAutomatic
        .MarkerStyle = xlNone
        .Smooth = False
        .MarkerSize = 5
        .Shadow = False
    End With
    ActiveChart.ChartArea.Select
    ActiveSheet.Shapes("Diagramm 1").ScaleWidth 1.55, msoFalse, _  
        msoScaleFromTopLeft
End Sub

Mein Problem ist ich kann nicht auf variable Diagramme/Tabellenblätter zugreifen, sondern nur auf eingetragene (Diagramm1/Tabelle6)
könnte man das irgendwie umgehen.

SO
da keiner bis jetzt eine Antwort hatte
Habe ich ein bisschen herum experimentiert

Public Sub test()
  
  Dim Anzahl  As Long
  Dim Fehler  As Boolean
  Dim Dateien As Variant
  
  On Error Resume Next
  
  Application.ScreenUpdating = False
  Dateien = Application.GetOpenFilename("Alle Dateien (*.*),*.*", False, False, False, True)  
  Fehler = CBool(Dateien)
  
  
  If Not Fehler And Not Err.Number <> 0 Then
  
    MsgBox "Sie haben keine Datei ausgewählt!", 48, "Keine Datei ausgewählt"  
    
    Exit Sub
  
  End If
 
  
  For Anzahl = LBound(Dateien) To UBound(Dateien)
MsgBox (Anzahl)
    'ActiveWorkbook.Worksheets.Add  
    With ActiveSheet.QueryTables.Add(Connection:="TEXT" + Dateien(Anzahl), Destination:=Range("A1"))  
        .Name = Dateien(Anzahl)
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = ""  
        .TextFileColumnDataTypes = Array(1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
 
    
    
    Range("A1").Select  
    Selection.CurrentRegion.Select
    Set objChart = ActiveWorksheet.ChartObjects.Add(100, 50, 300, 200).Chart
    Charts.Add
    ActiveChart.ChartType = xlLine
    ActiveChart.SetSourceData Source:=Sheets(Dateien(Anzahl)).Range("A2:B1001"), PlotBy:=xlColumns  
    ActiveChart.Location Where:=xlLocationAsObject, Name:="Tabelle2"  
    With ActiveChart
        .HasTitle = False
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Time [sec]"  
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Pressure [bar]"  
    End With
    
    ActiveChart.HasLegend = False
    ActiveChart.HasDataTable = False
    
    ActiveWindow.Visible = False
    Windows("test.xls").Activate  
    Range("A1").Select  
        
  Next Anzahl
  
End Sub

mein Problem ist noch, dass ich die Tabellenblätter nicht mit den Namen der datei bennen kann
und an einigen stellen funktioniert es immernoch nicht
wenn ich mehr als 200 dateien importiere (hauptsachlich *.rtf dateien), gibt es probleme beim importieren, sodass keine Werte angezeigt werden.
gibt es eine möglichkeit die anzahl der Tabellenblätter zu reseten, also wenn man 150 tabellenblätter geöffnet hat und 140 stück löscht, dann ein weiteres hinzufügt soll dieser nicht bei 151 anfangen.

mfg
Broken

Frage VB for Applications Entwicklung

Mehr von Broken

Veritas Replication.exec 3.1 mehrere replic VersionenBroken

Acronis True Image home 2009 UsbStick erstellenBroken - 10 Kommentare

VBA smtp mailsBroken - 5 Kommentare

Java Parabel mit Koordinationssystem erzeugenBroken - 1 Kommentar

Heiß diskutiert