Hallo

Das untenstehende Makro lief wie gewünscht.
Im Makro werden Daten importiert.
Kolonne A wird angepasst, Oben wird eine neue Zeile A eingefügt und angepasst.
Dann wird die Zeitachse (=Kolonne A) an vorletzter Stelle eingefügt.
Dann wird ein Zellenbereich ausgewählt und daraus ein Chart erzeugt und als neues Blatt "Zellen" abgespeichert.
Ähnliches geschieht für das Blatt "Total"
Dann wird man gefragt ob man unter einem aus den Eingangsdatei abgeleitetem Namen als XLSX abspeichern will.
Wenn man die Arbeitsmappe dann schliessen will - wird man nochmal aufgefordert abzuspeichern.
Wählt man hiern "Nein" kommt man nicht raus.
Wählt amn "Ja" erscheint ein Hinweis dass einige Elements verloren gehen wenn man als Unicode abgespeichert.
Danach ist diese abgespeicherte Datei dann auch nicht lesbar mit Excel.

Eigentlich lief das Makro korrekt (inkl.abspeichern) durch.
Dann habe ich aber in beiden Charts ("Zellen" und "Total")die Legende eingefügt sowie als Category- und Value-achse die Wörter "Minutes" und "Volt" eingefügt.
Ab diesem Moment hatte ich das Problem :-((
Im Makro steht das zu Begin der unteren Hälfte.
Ich sehe leider nicht wo hier der Hase im Pfeffer liegt.
Ich würde mich freuen wenn jemand mir einen kleinen Schubs geben könnte.

Ansonsten wüsche ich allen alles Gute im neuen Jahr.



Hier das Makro:


Sub BattImport()
'
' BattImport Macro
'
' Keyboard Shortcut: Ctrl+b
'

Dim varName As Variant
Dim strName As String
Dim Neuer_Dateiname As String
Dim strTabname As String
Dim oChrt As ChartObject
Dim Chrt As Chart
Dim loletzte As Long
Dim strPfad As String

'Pfad festlegen
strPfad = "C:\Akku\"
'Laufwerk und Pfad zum Öffnen vorgeben
ChDrive "C"
ChDir strPfad

'Datei-Öffnen-Dialog aufrufen
varName = Application.GetOpenFilename("Text-Dateien (*.txt),*.txt")

'Letztes \ ermitteln um Pfad und Dateiname zu trennen
strName = Right$(varName, Len(varName) - InStrRev(varName, "\"))

'Letzten . ermitteln um Dateiname und Erweiterung zu trennen
strName = Left(strName, InStrRev(strName, ".") - 1)


Workbooks.OpenText Filename:=varName, Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, Comma:=False, _
Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3 _
, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, _
1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), _
Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), Array( _
23, 1), Array(24, 1), Array(25, 1), Array(26, 1)), DecimalSeparator:=".", _
TrailingMinusNumbers:=True

'Werte in Zellen A1 und A2 schreiben
Range("A1") = "0"
Range("A2") = "0.2"
Range("A3") = "0.4"
Range("A4") = "0.6"

'letzte Zeile in Spalte A im aktiven Blatt ermitteln
loletzte = ActiveWorkbook.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

'Werte auffüllen
With Range("A2:A3:A4")
.AutoFill Destination:=Range("A2:A" & loletzte), Type:=xlFillDefault
End With

'Name des aktiven Arbeitsblattes in Variable schreiben
strTabname = ActiveWorkbook.ActiveSheet.Name

Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B1").Select
ActiveCell.FormulaR1C1 = "Zelle 1"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Zelle 2"
Range("B1:C1").Select
Selection.AutoFill Destination:=Range("B1:Y1"), Type:=xlFillDefault
Range("B1:Y1").Select
Range("Z1").Select
ActiveCell.FormulaR1C1 = "Total"
Columns("Z:Z").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveWindow.LargeScroll ToRight:=-1
Columns("A:A").Select
Selection.Copy
ActiveWindow.LargeScroll ToRight:=1
Columns("Z:Z").Select
ActiveSheet.Paste
ActiveSheet.Shapes.AddChart2(227, xlLine).Select
ActiveChart.SetSourceData Source:=ActiveWorkbook.Sheets(strTabname).Range("$A$1:$Y$" & loletzte)
ActiveChart.SetElement (msoElementChartTitleAboveChart)

ActiveChart.ChartArea.Select
ActiveChart.SetElement (msoElementLegendBottom)

' ab dieser Aktion trat das Problem auf
ActiveChart.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
ActiveChart.SetElement (msoElementPrimaryValueAxisTitleAdjacentToAxis)
ActiveChart.Axes(xlCategory).AxisTitle.Select
ActiveChart.Axes(xlCategory, xlPrimary).AxisTitle.Text = "Minutes"
Selection.Format.TextFrame2.TextRange.Characters.Text = "Minutes"
With Selection.Format.TextFrame2.TextRange.Characters(1, 7).ParagraphFormat
.TextDirection = msoTextDirectionLeftToRight
.Alignment = msoAlignCenter
End With
With Selection.Format.TextFrame2.TextRange.Characters(1, 7).Font
.BaselineOffset = 0
.Bold = msoFalse
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(89, 89, 89)
.Fill.Transparency = 0
.Fill.Solid
.Size = 10
.Italic = msoFalse
.Kerning = 12
.Name = "+mn-lt"
.UnderlineStyle = msoNoUnderline
.Strike = msoNoStrike
End With

ActiveChart.ChartArea.Select
ActiveChart.Axes(xlValue, xlPrimary).HasTitle = True
ActiveChart.Axes(xlValue).AxisTitle.Select
ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Text = "Volt"
Selection.Format.TextFrame2.TextRange.Characters.Text = "Volt"
With Selection.Format.TextFrame2.TextRange.Characters(1, 4).ParagraphFormat
.TextDirection = msoTextDirectionLeftToRight
.Alignment = msoAlignCenter
End With
With Selection.Format.TextFrame2.TextRange.Characters(1, 4).Font
.BaselineOffset = 0
.Bold = msoFalse
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(89, 89, 89)
.Fill.Transparency = 0
.Fill.Solid
.Size = 10
.Italic = msoFalse
.Kerning = 12
.Name = "+mn-lt"
.UnderlineStyle = msoNoUnderline
.Strike = msoNoStrike
End With




ActiveChart.PlotArea.Select
ActiveChart.ChartTitle.Select
Application.CutCopyMode = False
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="Zellen"
ActiveWorkbook.Sheets(strTabname).Select
ActiveWindow.LargeScroll ToRight:=1
ActiveSheet.Shapes.AddChart2(227, xlLine).Select
ActiveChart.SetSourceData Source:=ActiveWorkbook.Sheets(strTabname).Range("$Z$1:$AA$" & loletzte)
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="Total"
ActiveChart.Axes(xlCategory, xlPrimary).HasTitle = True
ActiveChart.Axes(xlCategory).AxisTitle.Select
ActiveChart.Axes(xlCategory, xlPrimary).AxisTitle.Text = "Minutes"
Selection.Format.TextFrame2.TextRange.Characters.Text = "Minutes"

ActiveChart.ChartArea.Select
ActiveChart.Axes(xlValue, xlPrimary).HasTitle = True
ActiveChart.Axes(xlValue).AxisTitle.Select
ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Text = "Volt"
Selection.Format.TextFrame2.TextRange.Characters.Text = "Volt"

ActiveWorkbook.Sheets(strTabname).Select
ActiveWorkbook.Sheets(strTabname).Move Before:=Sheets(1)
Range("AB258").Select

'Speichern-unter Dialog aufrufen
Neuer_Dateiname = Application.GetSaveAsFilename(InitialFileName:=strPfad & strName & ".xlsx", fileFilter:="Excel-Arbeitsmappe, *.xlsx")
'falls Abbrechen gedrückt wird, Makro verlassen
If Neuer_Dateiname = "Falsch" Then
'Meldung Makroabbruch
MsgBox "Workbook not saved!", 48, "Abort by user"
Exit Sub
End If
'aktive Arbeitsmappe speichern
ActiveWorkbook.SaveAs Filename:=Neuer_Dateiname

End Sub