Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

VBA-Skript auf alle Tabellenblätter beziehen
#1
Brick 
Hallo liebe Community,

ich hoffe, ihr könnt mir bei folgendem Problem helfen.
Ich habe Excel-Dateien, in denen ein über VBA programmiertes Makro geschrieben wurde (nicht von mir).

Es geht um einen Speiseplan, der aus unserem WaWi-System exportiert wird. Wenn die Datei geöffnet wird, schaltet das Makro und stellt bei den Gerichten die Allergene und Zusatzstoffe hoch.

In anderen Tabellenblättern habe ich z.B. Tagesaushänge, wo einfach nur normale Verknüpfungen zum Speiseplan-Blatt sind (z.B. =Speiseplan!B12).

Das Makro hat bisher die Allergene und Zusatzstoffe in allen Tabellenblättern hochgestellt, auch in den Verknüpfungen (obwohl ich gelesen hatte, dass Formatierungen nicht bei Verknüpfungen übernommen werden).

Nun musste von unserer IT-Abteilung meine Office-Umgebung auf Deutsch umgestellt werden (vorher Englisch) und plötzlich funktioniert dieses Makro nicht mehr.
Es stellt nur noch die Zeichen im Speiseplan-Blatt hoch, nicht mehr in den Tagesaushängen.

Was genau ist da passiert, und was muss ich ändern, damit es wieder funktioniert?
Hier das Skript aus VBA und als Anhang ein Testexport aus unserem System:

Code:
Private Sub Workbook_Open()
Application.CalculateFull
If ActiveWorkbook.Worksheets("Daten").Range("B11").Value = "1" Then
    FormatIngridients
End If
End Sub
Function FormatIngridients()
' Deklarationsteil
Const startTag = "#MBS"
Const endTag = "MBS#"
Dim foundCell As Range
Dim blattzahl As Integer
    ' Erste Zelle auswählen damit die Suche
    ' funktioniert und alle möglichen Zellen findet
   
blattzahl = ActiveWorkbook.Sheets.Count
blattzahl = blattzahl - 3
For i = 1 To blattzahl
   
    ActiveWorkbook.Worksheets(i).Activate
   
    ' Erste Zelle suchen
    Set foundCell = Cells.Find(startTag, After:=Range("A1"), LookIn:=xlValues, LookAt:=xlPart)
   
    Do
        If Not foundCell Is Nothing Then
            ' Formelwert in Zelle übernehmen
            foundCell.FormulaR1C1 = foundCell.Value
           
            ' Indices für die Inhaltsstoffe
            Dim startIndex As Integer
            Dim endIndex As Integer
           
            ' Liste für die Indizes zum Hochstellen
            Dim indexList() As Integer
            Dim ind As Integer ' Index
           
            ' Ersten Startindex zuweisen
            startIndex = InStr(1, foundCell.Value, startTag, vbTextCompare)
            ReDim indexList(1)
            indexList(1) = startIndex
           
            ' Innere Schleife zur Textformatierung und Ersetzung der Markierungen
            Do While Not startIndex = 0
           
            ' Bei erstem Schleifendurchlauf, darf Startindex noch nicht zugewiesen werden
            If Not UBound(indexList) = 1 Then
                ind = UBound(indexList)
                ReDim Preserve indexList(ind + 1)
                ' Startindex übernehmen
                indexList(ind + 1) = startIndex
            End If
           
            ' StartTag entfernen - Zur Berechnung des korrekten EndIndex
            foundCell.Value = Replace(foundCell.Value, startTag, "", 1, 1)
           
            ' EndTag suchen
            If endIndex = 0 Then
                endIndex = InStr(1, foundCell.Value, endTag, vbTextCompare)
            Else
                endIndex = InStr(startIndex, foundCell.Value, endTag, vbTextCompare)
            End If
           
            ind = UBound(indexList)
            ReDim Preserve indexList(ind + 1)
           
            ' Endindex übernehmen
            indexList(ind + 1) = endIndex
           
            ' Endtag entfernen
            foundCell.Value = Replace(foundCell.Value, endTag, "", 1, 1)
           
            ' Nächsten StartTag suchen
            startIndex = InStr(endIndex, foundCell.Value, startTag, vbTextCompare)
           
            Loop ' Ende Schleife: "Indices für hochgestelltes formatieren ermitteln"
           
            ' Hochgestellte Zusatzstoffe nach Ersetzung der Tags
            For x = 1 To UBound(indexList) - 1 Step 2 ' In 2er-Schritten, da immer Start (1) / Endindex (2), usw.
           
                st = indexList(x) 'Startindex
                ende = indexList(x + 1) 'Endindex
               
                With foundCell.Characters(st, ende - st).Font
                    .Superscript = True
                End With
                Next x
               
                ' Speicherfreigabe der IndexListe
                Erase indexList()
               
                ' Nächste Zelle zuweisen
                Set foundCell = Cells.FindNext(After:=foundCell)
           
        End If ' Ende If foundCell != null
    Loop While Not foundCell Is Nothing ' Ende Schleife: "nach Zellen suchen"
   
    Next i
End Function

Ich hoffe auf eure Hilfe und bedanke mich im Voraus!


Viele Grüße,

Denis L.


Angehängte Dateien
.xlsm   Testexport.xlsm (Größe: 700,39 KB / Downloads: 2)
Antworten Top
#2
Ihr habt doch eine IT-Abteilung ??

Diese Code reicht:

Code:
Private Sub Workbook_Open()
  sn = Sheets("Datenkomponenten").Cells(2, 1).CurrentRegion.Resize(, 11)
    
  For j = 2 To UBound(sn)
    If sn(j, 4) <> "" Then Sheets("Speiseplan").Cells.Replace sn(j, 4), sn(j, 4) & " " & sn(j, 10) & IIf(sn(j, 10) = "", "", " ") & sn(j, 11)
  Next
End Sub
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Antworten Top
#3
(28.03.2017, 10:45)snb schrieb: Ihr habt doch eine IT-Abteilung ??

Hi,

wenn die IT bei uns eine Option wäre, würde ich nicht im Forum fragen :)

Unsere IT sitzt Zentral in Frankfurt, und wir sind in Düsseldorf, bis dort mal jemand ein Ticket bearbeitet, können Wochen vergehen, und ich brauch da relativ dringend eine Lösung.


Kann ich einfach blind die Befehle im Skript nach der Liste in deinem Link ändern?
Ich habe so eine ähnliche Liste mal gefunden, aber die war eher auf Excel-Funktionen als auf VBA-Befehle bezogen. Aber wenn das die entsprechende VBA-Liste ist, dann probiere ich das aus und gebe Bescheid, ob's geklappt hat, danke!
Antworten Top
#4
(28.03.2017, 10:45)snb schrieb: Ihr habt doch eine IT-Abteilung ??

Hi nochmal,

funktioniert leider nicht. Scheitert schon daran, wenn ich den Beginn des VBA-Skripts "if ... then... " in "wenn... dann..." ändere. Kann man bei der Programmiersprache überhaupt deutsche Befehle benutzen?
Antworten Top
#5
schau meine vorherige Post + Lösung.

VBA is US-sprachig.
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Antworten Top
#6
(28.03.2017, 11:14)snb schrieb: schau meine vorherige Post + Lösung.

VBA is US-sprachig.

Okay, bin anscheinend blind, hab den Code nicht gesehen :)

Ich probier's aus und melde mich, danke!
Antworten Top
#7
(28.03.2017, 11:14)snb schrieb: schau meine vorherige Post + Lösung.

VBA is US-sprachig.

Okay, es funktioniert nicht. Wo genau muss ich deinen Code einfügen? Wenn ich den oberen Teil ersetze, greift dieses "FormatIngridients"-Skript nicht mehr.
Muss die Zeile noch irgendwo dazwischen?


Danke!
Antworten Top
#8
Weist du was 'Diese Code reicht' bedeutet ?
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Antworten Top
#9
(28.03.2017, 11:43)snb schrieb: Weist du was 'Diese Code reicht' bedeutet ?

Du meinst also, ich soll meinen gesamten Code durch deinen ersetzen? Das habe ich auch schon ausprobiert, dann passiert nichts. Der Code, den wir benutzen, löst ja aus, dass alles, was zwischen "#MBS" und "MBS#" steht, hochgestellt wird.
Und dann alle Zellen durchgeht.


Was dein Code allerdings macht, ist mir grad aufgefallen, er setzt die Allergene und Zusatzstoffe wieder runter und verdreifacht sie.
Antworten Top
#10
Also nur nochmal zum Verständnis, vielleicht habe ich es nicht optimal ausgedrückt.
Der Code, wie ich ihn gepostet habe, funktioniert. Aber nur, wenn Office auf Englisch eingestellt ist. Was muss an dem Code geändert werden, damit der auch in Deutscher Einstellung das gleiche Ergebnis bringt?
Bzw. weiß jemand, woran es liegt, dass das Skript auf Deutsch plötzlich nicht mehr richtig ausgeführt wird? Bzw. nicht komplett?


Danke!
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste