Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
768to772
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
768to772
768to772
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Problem verbundene Zellen

Problem verbundene Zellen
08.06.2006 20:27:59
SteffenS
Hallo und guten Abend,
ich habe ein Problem bei dem ich Eure Hilfe brauche.
Ich habe mir eine Schleife gebaut bei der ich die Eigenschaften von Zellen verändere, dies funktioniert auch größtenteil, nur bei den verbundenen Zellen erscheint ein Fehler.
Wie bekomme ich auch die verbundenen Zellen angepaßt?
Hier mein Code:
'Zellen abfragen
For Each wkb In Workbooks
If wkb.Name "TF1.xls" Then
For Each wks In wkb.Worksheets
If wks.Name "Leer" Then
wks.Unprotect (PSWDTP)
'Schutz setzen
With wks.Cells
.Locked = True
.FormulaHidden = False
End With
'schutz bei gelben zellen aufheben
For i = 1 To 6000
For j = 1 To 210
If wkb.Sheets(wks.Name).Cells(i, j).Interior.ColorIndex = 6 Then
wkb.Sheets(wks.Name).Cells(i, j).Locked = False
zaehler = zaehler + 1
End If
Next j
Next i
wks.Protect Password:=PSWDTP, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True
End If
Next wks
End If
Next wkb
Danke Euch schon vielmals
Steffen Schmerler

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Code lesbar
08.06.2006 21:06:05
Reinhard
Hi Steffen,
'Option Explicit
Sub tt()
'Zellen abfragen
For Each wkb In Workbooks
If wkb.Name <> "TF1.xls" Then
For Each wks In wkb.Worksheets
If wks.Name <> "Leer" Then
wks.Unprotect (PSWDTP)
'Schutz setzen
With wks.Cells
.Locked = True
.FormulaHidden = False
End With
'schutz bei gelben zellen aufheben
For i = 1 To 6000
For j = 1 To 210
If wkb.Sheets(wks.Name).Cells(i, j).Interior.ColorIndex = 6 Then
wkb.Sheets(wks.Name).Cells(i, j).Locked = False
zaehler = zaehler + 1
End If
Next j
Next i
wks.Protect Password:=PSWDTP, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True
End If
Next wks
End If
Next wkb
End Sub

Gruß
Reinhard
Anzeige
AW: Problem verbundene Zellen
08.06.2006 21:25:34
Kay
Hallo Steffen,
probiere das aus:
If wkb.Sheets(wks.Name).Cells(i, j).Interior.ColorIndex = 6 Or wkb.Sheets(wks.Name).Cells(i, j).MergeCells = True Then
...
MfG
Kay
fehler trotzdem noch da
08.06.2006 22:52:35
SteffenS
habe das jetzt so angepaßt:
If wkb.Sheets(wks.Name).Cells(i, j).Interior.ColorIndex = 6 Or wkb.Sheets(wks.Name).Cells(i, j).MergeCells = True Then
wkb.Sheets(wks.Name).Cells(i, j).Locked = False
zaehler = zaehler + 1
End If
Der Fehler bleibt aber der Gleiche.
Bitte helft mir nochmal.
Danke
Steffen
AW: fehler trotzdem noch da
08.06.2006 23:09:12
Josef
Hallo Steffen!
Das geht so.
Sub tt()
'Zellen abfragen
For Each wkb In Workbooks
  If wkb.Name <> "TF1.xls" Then
    For Each wks In wkb.Worksheets
      If wks.Name <> "Leer" Then
        With wks
          .Unprotect (PSWDTP)
          'Schutz setzen
          With .Cells
            .Locked = True
            .FormulaHidden = False
          End With
          'schutz bei gelben zellen aufheben
          For i = 1 To 6000
            For j = 1 To 210
              If .Cells(i, j).MergeCells Then
                If .Cells(i, j).MergeArea.Interior.ColorIndex = 6 Then
                  .Cells(i, j).MergeArea.Locked = False
                  zaehler = zaehler + 1
                End If
              Else
                If .Cells(i, j).Interior.ColorIndex = 6 Then
                  .Cells(i, j).Locked = False
                  zaehler = zaehler + 1
                End If
              End If
            Next
          Next
          .Protect Password:=PSWDTP, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True
        End With
      End If
    Next
  End If
Next
End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
Danke,
09.06.2006 10:14:10
SteffenS
funktioniert so.
MFG
Steffen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige