Hallo Leute,
ich habe ein großes, für euch wahrscheinlich sehr kleines Problem. Ich möchte einen markierten Tabellenbereich, den ich selber markiere, zellenweise durchsuchen lassen. Jede Zelle soll dabei untersucht werden ob sie die Schrichtart Wingdings hat. Wenn sie diese hat wird sie speziell formatiert und die Göße über eine Umrechnung mit einer Zahl im Nachbarfeld bestimmt. Das funktioniert wunderbar. Null Probleme. Ich habe das Problem, das der Bereich den ich angebe nicht komplett durchlaufen wird, sondern immer nur spaltenweise. Markiere ich eine Spalte so wird diese wunderbar von oben nach unten durchlaufen. Ich möchte aber alle Felder in meiner Tabelle durchlaufen lassen, aber da kriege ich immer einen Error. Ich habe euch das Listing mal angehangen. Vieleicht hat jemand eine Idee.
Danke im Vorraus....Joris
Dim Zelle As Range
For Each Zelle In Selection
If Zelle.Font.Name = "Wingdings" Then
hundert = 500
Selection.Offset(0, 1).Range("A1").Select
inh = Selection()
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Offset(0, -1).Range("A1").Select
groesse = 48 * inh / hundert
groesse = Int(groesse)
If groesse >= 1 Then
Selection() = "l"
With Selection.Font
.Name = "Wingdings"
.Size = (groesse)
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
End If
Selection.Offset(1, 0).Range("A1").Select
Else
MsgBox "Falsches Feld gewählt"
Selection.Offset(1, 0).Range("A1").Select
End If
Next Zelle
End Sub
