Supportnet / Forum / Tabellenkalkulation

Public Sub auto_open() Dim i As Integer Dim N As Integer ´Dim ZZelle As String ´Dim ZBereich As String Application.ScreenUpdating = False Range("D18:AH36").Select Selection.Interior.ColorIndex = xlNone Selection.Font.ColorIndex = 0 For i = 18 To 36 ´Zeile For N = 4 To 34 ´Reihe ´ZZelle = Cells(n, i) Cells(N, i).Select If Cells(i, N).Value = "F" Then Cells(i, N).Interior.ColorIndex = 36 If Cells(i, N).Value = "Ko" Then Cells(i, N).Font.ColorIndex = 4 If Cells(i, N).Value = "U" Then Cells(i, N).Font.ColorIndex = 3 If Cells(i, N).Value = "Ua" Then Cells(i, N).Font.ColorIndex = 50 If Cells(i, N).Value = "ZF" Then Cells(i, N).Font.ColorIndex = 5 If Cells(i, N).Value = "K" Then Cells(i, N).Font.ColorIndex = 7 If Cells(i, N).Value = "A" Then Cells(i, N).Font.ColorIndex = 44 If Cells(i, N).Value = "Su" Then Cells(i, N).Font.ColorIndex = 45 If Cells(i, N).Value = "SÜ" Then Cells(i, N).Font.ColorIndex = 30 If Cells(i, N).Value = "SÜ" Then Cells(i, N).Interior.ColorIndex = 4 If Cells(i, N).Value = "AF" Then Cells(i, N).Font.ColorIndex = 10 If Cells(i, N).Value = "S" Then Cells(i, N).Font.ColorIndex = 5 If Cells(i, N).Value = "S" Then Cells(i, N).Interior.ColorIndex = 43 If Cells(i, N).Value = "B" Then Cells(i, N).Font.ColorIndex = 10 If Cells(i, N).Value = "B" Then Cells(i, N).Interior.ColorIndex = 44 If Cells(i, N).Value = "0" Then Cells(i, N).Font.ColorIndex = 6 If Cells(i, N).Value = "0" Then Cells(i, N).Interior.ColorIndex = 3 If Cells(i, N).Value = "1" Then Cells(i, N).Font.ColorIndex = 6 If Cells(i, N).Value = "1" Then Cells(i, N).Interior.ColorIndex = 3 If Cells(i, N).Value = "2" Then Cells(i, N).Font.ColorIndex = 6 If Cells(i, N).Value = "2" Then Cells(i, N).Interior.ColorIndex = 3 If Cells(i, N).Value = "3" Then Cells(i, N).Font.ColorIndex = 6 If Cells(i, N).Value = "3" Then Cells(i, N).Interior.ColorIndex = 3 If Cells(i, N).Value = "4" Then Cells(i, N).Font.ColorIndex = 6 If Cells(i, N).Value = "4" Then Cells(i, N).Interior.ColorIndex = 3 If Cells(i, N).Value = "5" Then Cells(i, N).Font.ColorIndex = 6 If Cells(i, N).Value = "5" Then Cells(i, N).Interior.ColorIndex = 3 If Cells(i, N).Value = "6" Then Cells(i, N).Font.ColorIndex = 6 If Cells(i, N).Value = "6" Then Cells(i, N).Interior.ColorIndex = 3 If Cells(i, N).Value = "7" Then Cells(i, N).Font.ColorIndex = 6 If Cells(i, N).Value = "7" Then Cells(i, N).Interior.ColorIndex = 3 If Cells(i, N).Value = "8" Then Cells(i, N).Font.ColorIndex = 1 If Cells(i, N).Value = "9" Then Cells(i, N).Font.ColorIndex = 50 If Cells(i, N).Value = "9" Then Cells(i, N).Interior.ColorIndex = 43 If Cells(i, N).Value = "10" Then Cells(i, N).Font.ColorIndex = 26 If Cells(i, N).Value = "10" Then Cells(i, N).Interior.ColorIndex = 43 If Cells(i, N).Value = "11" Then Cells(i, N).Font.ColorIndex = 26 If Cells(i, N).Value = "11" Then Cells(i, N).Interior.ColorIndex = 43 If Cells(i, N).Value = "12" Then Cells(i, N).Font.ColorIndex = 26 If Cells(i, N).Value = "12" Then Cells(i, N).Interior.ColorIndex = 43 If Cells(i, N).Value = "13" Then Cells(i, N).Font.ColorIndex = 26 If Cells(i, N).Value = "13" Then Cells(i, N).Interior.ColorIndex = 43 If Cells(i, N).Value = "14" Then Cells(i, N).Font.ColorIndex = 26 If Cells(i, N).Value = "14" Then Cells(i, N).Interior.ColorIndex = 43 If Cells(i, N).Value = "15" Then Cells(i, N).Font.ColorIndex = 26 If Cells(i, N).Value = "15" Then Cells(i, N).Interior.ColorIndex = 43 If Cells(i, N).Value = "16" Then Cells(i, N).Font.ColorIndex = 26 If Cells(i, N).Value = "16" Then Cells(i, N).Interior.ColorIndex = 43 ActiveCell.Offset(0, 1).Activate Next N Next i End Sub

Problem mit Fahrrad

Rahmen, Kette, Reifen, Lenker

Könntest du helfen? :)

Im Klartext: Was ist dein Problem, was soll passieren? Wann soll dies passieren...

Gruß
futterer

Hier weden ja die Buchstaben gefärbt, wie du sicherlich festgestellt hast, mir ist jetzt die ursache für mein problem bekannt, wenn ich das Blatt schüze dann läßt sich das makro nicht mehr aktivieren, ich muß aber das Blatt schützen, das mir keiner die formlen verändert dich sich dort befinden, kannst di mir helfen und sagen, was ich in das makro schreiben muß das es trotz Blattschutz trotzdem geht?

Danke schon mal im voraus

HAllo u113,

dann musst Du am Anfang des Makros Deinen Blattschutz aufheben und am Ende wieder setzen. Ich habe das in Deinem Makro mal eingefügt. Die Zeilen, die dafür Notwendig sind, habe ich fett formatiert. Tausche das nachfolgende Makro gegen Deines aus.

Public Sub auto_open()
Dim i As Integer
Dim N As Integer
Rem: Dim ZZelle As String
Rem: Dim ZBereich As String
ActiveSheet.Unprotect "Hier das Blattschutzpasswort eintragen"
Application.ScreenUpdating = False
Range("D18:AH36").Select
Selection.Interior.ColorIndex = xlNone
Selection.Font.ColorIndex = 0
Rem: Zeile
For i = 18 To 36
Rem: Reihe
For N = 4 To 34
´ZZelle = Cells(N, i)
Cells(N, i).Select
If Cells(i, N).Value = "F" Then Cells(i, N).Interior.ColorIndex = 36
If Cells(i, N).Value = "Ko" Then Cells(i, N).Font.ColorIndex = 4
If Cells(i, N).Value = "U" Then Cells(i, N).Font.ColorIndex = 3
If Cells(i, N).Value = "Ua" Then Cells(i, N).Font.ColorIndex = 50
If Cells(i, N).Value = "ZF" Then Cells(i, N).Font.ColorIndex = 5
If Cells(i, N).Value = "K" Then Cells(i, N).Font.ColorIndex = 7
If Cells(i, N).Value = "A" Then Cells(i, N).Font.ColorIndex = 44
If Cells(i, N).Value = "Su" Then Cells(i, N).Font.ColorIndex = 45
If Cells(i, N).Value = "SÜ" Then Cells(i, N).Font.ColorIndex = 30
If Cells(i, N).Value = "SÜ" Then Cells(i, N).Interior.ColorIndex = 4
If Cells(i, N).Value = "AF" Then Cells(i, N).Font.ColorIndex = 10
If Cells(i, N).Value = "S" Then Cells(i, N).Font.ColorIndex = 5
If Cells(i, N).Value = "S" Then Cells(i, N).Interior.ColorIndex = 43
If Cells(i, N).Value = "B" Then Cells(i, N).Font.ColorIndex = 10
If Cells(i, N).Value = "B" Then Cells(i, N).Interior.ColorIndex = 44
If Cells(i, N).Value = "0" Then Cells(i, N).Font.ColorIndex = 6
If Cells(i, N).Value = "0" Then Cells(i, N).Interior.ColorIndex = 3
If Cells(i, N).Value = "1" Then Cells(i, N).Font.ColorIndex = 6
If Cells(i, N).Value = "1" Then Cells(i, N).Interior.ColorIndex = 3
If Cells(i, N).Value = "2" Then Cells(i, N).Font.ColorIndex = 6
If Cells(i, N).Value = "2" Then Cells(i, N).Interior.ColorIndex = 3
If Cells(i, N).Value = "3" Then Cells(i, N).Font.ColorIndex = 6
If Cells(i, N).Value = "3" Then Cells(i, N).Interior.ColorIndex = 3
If Cells(i, N).Value = "4" Then Cells(i, N).Font.ColorIndex = 6
If Cells(i, N).Value = "4" Then Cells(i, N).Interior.ColorIndex = 3
If Cells(i, N).Value = "5" Then Cells(i, N).Font.ColorIndex = 6
If Cells(i, N).Value = "5" Then Cells(i, N).Interior.ColorIndex = 3
If Cells(i, N).Value = "6" Then Cells(i, N).Font.ColorIndex = 6
If Cells(i, N).Value = "6" Then Cells(i, N).Interior.ColorIndex = 3
If Cells(i, N).Value = "7" Then Cells(i, N).Font.ColorIndex = 6
If Cells(i, N).Value = "7" Then Cells(i, N).Interior.ColorIndex = 3
If Cells(i, N).Value = "8" Then Cells(i, N).Font.ColorIndex = 1
If Cells(i, N).Value = "9" Then Cells(i, N).Font.ColorIndex = 50
If Cells(i, N).Value = "9" Then Cells(i, N).Interior.ColorIndex = 43
If Cells(i, N).Value = "10" Then Cells(i, N).Font.ColorIndex = 26
If Cells(i, N).Value = "10" Then Cells(i, N).Interior.ColorIndex = 43
If Cells(i, N).Value = "11" Then Cells(i, N).Font.ColorIndex = 26
If Cells(i, N).Value = "11" Then Cells(i, N).Interior.ColorIndex = 43
If Cells(i, N).Value = "12" Then Cells(i, N).Font.ColorIndex = 26
If Cells(i, N).Value = "12" Then Cells(i, N).Interior.ColorIndex = 43
If Cells(i, N).Value = "13" Then Cells(i, N).Font.ColorIndex = 26
If Cells(i, N).Value = "13" Then Cells(i, N).Interior.ColorIndex = 43
If Cells(i, N).Value = "14" Then Cells(i, N).Font.ColorIndex = 26
If Cells(i, N).Value = "14" Then Cells(i, N).Interior.ColorIndex = 43
If Cells(i, N).Value = "15" Then Cells(i, N).Font.ColorIndex = 26
If Cells(i, N).Value = "15" Then Cells(i, N).Interior.ColorIndex = 43
If Cells(i, N).Value = "16" Then Cells(i, N).Font.ColorIndex = 26
If Cells(i, N).Value = "16" Then Cells(i, N).Interior.ColorIndex = 43
ActiveCell.Offset(0, 1).Activate
Next N
Next i
ActiveSheet.Protect "Hier das Blattschutzpasswort eintragen"
End Sub

Ich hoffe, Du kommst klar. Bei Fragen melde Dich bitte wieder.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein}
^{Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Ich danke dir für deine schnelle hilfe!:-D
Das klappt einwandfrei!

Gruß Steve

Nun mußt du nur noch dein Makro gegen Einsicht schützen, damit der schlaue User nicht dein Blattschutzkennwort lesen kann ;o)

Arno

Ja das habe ich schon gemacht, danke für den Ratschlag ;-)

Gruß Ulle

Die User sind nämlich sowas von neugierig und destruktiv ;o)

Arno

aber das kann man ja trotzdem knacken, wenn mann weiß wie, denn Microsoft, hat in seine Programme keinen guten schutz eingebaut, evl, mit einer digitaln signatur versehen, dann ist der schutz besser, aber dazu muß das zertifikat auf dem PC ja vorhanden sein :-(

• makro rückgängig machen
• Excel Makro erscheint nicht in Makroliste
• Makro über Makro einfügen