Anzeige
Archiv - Navigation
1548to1552
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA-Skript auf alle Tabellenblätter beziehen

VBA-Skript auf alle Tabellenblätter beziehen
24.03.2017 15:33:04
Denis
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:
Private

Sub Workbook_Open()
Application.CalculateFull
If ActiveWorkbook.Worksheets("Daten").Range("B11").Value = "1" Then
FormatIngridients

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:=XlLookAt. _
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.

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA-Skript auf alle Tabellenblätter beziehen
24.03.2017 16:05:58
Luschi
Hallo Denis,
habe nur mal schell drübergeschaut, und dabei festgestellt:
- die Find-Methode hat das Arbument LookAt:=xlPart
  und nicht  LookAt:=XlLookAt.xlPart
Mehr dazu schaue ich mir heute Abend an.
Gruß von Luschi
aus klein-Paris
AW: VBA-Skript auf alle Tabellenblätter beziehen
27.03.2017 09:20:15
Denis
Hi Luschi, danke dir, ich hoffe, du findest evtl. eine Lösung für mich.
Anzeige

319 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige