Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
968to972
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
968to972
968to972
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
VBA verhindert kopieren
13.04.2008 12:33:00
Ulli
Hallo Zusammen,
folgendes Problem ist bei mir aufgetreten.
Um verschiedene Farben für eine Exceltabelle zu bekommen musste ich folgendes VBA schreiben:

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim cell As Range
For Each cell In Range("D11:N11")
If cell.Value > "0,19" And cell.Value = "0,19" And cell.Value  "0,29" And cell.Value  "0,49" And cell.Value  "0,69" And cell.Value  "0,80" Then cell.Font.ColorIndex = 3
If cell.Value > "0,80" Then cell.Interior.ColorIndex = 2
If cell.Value >= "0" And cell.Value = "0" And cell.Value 


Leider verhindert das Makro, dass ich während der normalen Arbeit mit der Tabelle, Zellen kopieren und ausschneiden kann. Ich habe bereits sehr viel im Internet recherchiert und immer nur gefunden, wie ich das kopieren verhindern kann, konnte daraus aber keine Rückschlüsse ziehen, wie ich es erlauben kann. Wahrscheinlich ist es nur ein typischer Anfängerfehler und für Euch ist es ein Leichtes diesen Fehler zu beheben.
Gruß Ulli

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA verhindert kopieren
13.04.2008 13:19:00
Renee
Hi Ulli,
Das Makro so für den SelectionChange Event keinen Sinn, da es jedesemal beim Wechsel einer Zelle durchlaufen wird. Es würde genügen, wenn es im Change Event stehen würde und dann so:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const tThisRange = "D11:N11"
Dim rC As Range
If Intersect(Target, Me.Range(tThisRange)) Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each rC In Me.Range("D11:N11")
If rC.Value > 0.19 And rC.Value = 0.19 And rC.Value  0.29 And rC.Value  0.49 And rC.Value  0.69 And rC.Value  0.8 Then rC.Font.ColorIndex = 3
If rC.Value > 0.8 Then rC.Interior.ColorIndex = 2
If rC.Value >= 0 And rC.Value = 0 And rC.Value 


GreetZ Renée

Anzeige
AW: VBA verhindert kopieren
13.04.2008 13:34:00
Reinhard
Hi Ulli,
Renee meinte
Private Sub Worksheet_Change(ByVal Target As Range)
misch mal meinen und ihren Ansatz und melde dich wenn du nicht klarkommst.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim z_Farbe, S_farbe 'z=Zelle,s=Schrift
On Error GoTo Fehler
Application.EnableEvents = False
S_farbe = 1
For Each cell In Range("D11:N11")
Select Case cell.Value
Case 0.19 To 0.29
z_Farbe = 3
Case 0.29 To 0.49
z_Farbe = 46
Case 0.69 To 0.8
z_Farbe = 6
Case Else
' irgendwas
End Select
cell.Interior.ColorIndex = z_Farbe
cell.Font.ColorIndex = S_farbe
Next cell
Exit Sub
Fehler:
Application.EnableEvents = True
End Sub


Gruß
Reinhard

Anzeige
AW: VBA verhindert kopieren
13.04.2008 13:51:00
Gerd
Na dann viel Spaß beim Mischen Uli!
'gehört ins Tabellenblattmodul

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Intersect(Target, Range(Cells(11, 4), Cells(11, 14))) Is Nothing Then
If Target.Count = 1 Then
If Application.CutCopyMode = False Then
With Target
Select Case .Value
Case Empty
.Interior.ColorIndex = 2
.Font.ColorIndex = 1
Case "-"
.Interior.ColorIndex = 2
.Font.ColorIndex = 1
Case Is > 0.8
.ColorIndex = 3
.Interior.ColorIndex = 2
Case Is > 0.69
.Interior.ColorIndex = 4
Case Is > 0.49
.Interior.ColorIndex = 6
Case Is > 0.29
.Interior.ColorIndex = 46
Case Is > 0.19
.Interior.ColorIndex = 3
.Font.ColorIndex = 1
Case Is >= 0
.Interior.ColorIndex = 15
.Font.ColorIndex = 15
End Select
End With
End If
End If
End If
End Sub


Gruß Gerd

Anzeige
AW: VBA verhindert kopieren
13.04.2008 17:33:00
Ulli
Recht vielen Dank für Eure schnelle Hilfe.
Die Antworten 1 und 3 haben mir sehr geholfen und konnten mein Problem beheben. Mit der Antwort 2 konnte ich nicht wirklich etwas anfangen, aber das liegt vielleicht an meiner Unerfahrenheit mit dem Thema.
Gruß Ulli

303 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige