219 Aufrufe
Gefragt in Windows 10 von
Bearbeitet

hallo M.O.

besten Dank für die super schnelle Antwort.

Leider ist das nicht die gewünschte Lösung. Vielleicht habe ich mich etwas unverständlich ausgedrückt.

Es geht mir nur um die Zahl hinter der ReNr, welche sich nach Aufruf der Rechnungsvorlage in Zelle E11        um 1 automatisch erhöhen soll. Die anderen benütze ich in Word. Den neuen Wert dann wieder hinter ReNr in Settings.txt schreiben.


[MacroSettings]
LS=28
Order=7
Rapport=5
Service=6
ReNr=3348

Besten Dank nochmals für Deine Mühe

bf

3 Antworten

0 Punkte
Beantwortet von m-o Profi (22.8k Punkte)

Hallo,

meinst du das so:

Sub settings()

Dim strPfad As String
Dim strDatei As String
Dim TxtDatei
Dim arrDatei(5, 1) As Variant
Dim Arr As Variant
Dim Tmp As Variant
Dim i As Integer
Dim t As Integer

'Pfad und Name der Datei - anpassen
strPfad = "C:\Users\Unbekannt\Documents\Settings.txt"

'Textdatei auslesen
Set FSO = CreateObject("Scripting.FilesystemObject")
Set TxtDatei = FSO.OpentextFile(strPfad)
strDatei = TxtDatei.readall
TxtDatei.Close

'Nach Datensätzen splitten
Arr = Split(strDatei, vbCrLf)

'nun die einzelnen Datensätze splitten; Trennzeichen = Gleichheitszeichen
For i = LBound(Arr) To UBound(Arr)
   Tmp = Split(Arr(i), "=")
     For t = LBound(Tmp) To UBound(Tmp)
       'hier werden die einzelnen gesplitteten Datensätze in
       arrDatei(intZaehler, t) = Tmp(t)
       'Zahlenwert um 1 erhöhen
       If t = 1 Then arrDatei(intZaehler, t) = arrDatei(intZaehler, t) + 1
     Next t
     intZaehler = intZaehler + 1
Next i

'Daten auf aktivem Blatt ausgeben - ohne Überschrift
For t = LBound(arrDatei, 1) + 1 To UBound(arrDatei, 1)
   Cells(t + 1, 1) = arrDatei(t, 0)
   Cells(t + 1, 2) = arrDatei(t, 1)
Next t

'neue Daten in Settingsdatei zurückschreiben
'Ggfs. vorhandene Ausgabedatei löschen
If Dir(strPfad) <> "" Then Kill (strPfad)

'Datei Öffen zur Ausgabe
Open strPfad For Output As #1

For t = LBound(arrDatei, 1) To UBound(arrDatei, 1)
  If t = 0 Then
    'Überschrift
    Print #1, arrDatei(t, 0)
  Else
    'übrige Daten
    Print #1, arrDatei(t, 0) & "=" & arrDatei(t, 1)
  End If
Next t

Close #1 'Datei schliessen

End Sub

Den Pfad sowie die Zellen für die Ausgabe in die Exceldatei musst du natürlich noch anpassen.

Kopiere das Makro in ein Standardmodul deiner Excel-Datei.

Gruß

M.O.

0 Punkte
Beantwortet von m-o Profi (22.8k Punkte)
 
Beste Antwort

Hallo,

dann so:

Sub settings()

Dim strPfad As String
Dim strDatei As String
Dim TxtDatei
Dim arrDatei(5, 1) As Variant
Dim Arr As Variant
Dim Tmp As Variant
Dim i As Integer
Dim t As Integer

'Pfad und Name der Datei
strPfad = "C:\Users\unbekannt\Documents\Settings.txt"

'Textdatei auslesen
Set FSO = CreateObject("Scripting.FilesystemObject")
Set TxtDatei = FSO.OpentextFile(strPfad)
strDatei = TxtDatei.readall
TxtDatei.Close

'Nach Datensätzen splitten
Arr = Split(strDatei, vbCrLf)

'nun die einzelnen Datensätze splitten; Trennzeichen = Gleichheitszeichen - ohne Überschrift
For i = LBound(Arr) To UBound(Arr)
   Tmp = Split(Arr(i), "=")
     For t = LBound(Tmp) To UBound(Tmp)
       'hier werden die einzelnen gesplitteten Datensätze in
       arrDatei(intZaehler, t) = Tmp(t)
     Next t
     intZaehler = intZaehler + 1
Next i

'Rechnungsnummer um 1 erhöhen
arrDatei(5, 1) = arrDatei(5, 1) + 1
'und in Zelle E11 ausgeben
Range("E11") = arrDatei(5, 1)

'neue Daten in Settingsdatei zurückschreiben
'Ggfs. vorhandene Ausgabedatei löschen
If Dir(strPfad) <> "" Then Kill (strPfad)

'Datei Öffen zur Ausgabe
Open strPfad For Output As #1

For t = LBound(arrDatei, 1) To UBound(arrDatei, 1)
  If t = 0 Then
    'Überschrift
    Print #1, arrDatei(t, 0)
  Else
    'übrige Daten
    Print #1, arrDatei(t, 0) & "=" & arrDatei(t, 1)
  End If
Next t

Close #1 'Datei schliessen

End Sub

Gruß

M.O.

P.S. Wenn du auf Antworten klickst, dann kannst du deine ursprüngliche Nachfrage konkretisieren und musst nicht deine ursprüngliche Anfrage bearbeiten.

0 Punkte
Beantwortet von bf Einsteiger_in (7 Punkte)
Hallo M.O.

besten Dank für Deine professionelle Unterstützung, hat super geklappt.

Ich wünsche Dir ein schönes Wochenende

bf
...