onbeveiligde cel enkel waarden schrijven

[Guillemyn1]

Hallo,

Ik heb een beveiligd tabblad waarbij ik enkele cellen onbeveiligd heb maar ik wil niet dat de layout van de cel aangepast wordt bv door kopiëren/plakken uit andere cel met andere achtergrondkleur.
Er mag dus enkel tekst/cijfers/tekens in de cel komen.

Hoe los ik dit best op aub?
PS het betreft een excelbestand met reeds macro's in.

groeten,
Koen

 

[edmoor]

Met dit achter dat werkblad:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) = "A1" Then
        With Selection.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End If
End Sub

 

[Guillemyn1]

Hallo,

bedankt,maar het werkt (nog) niet.
Ik heb deze code geplakt in dit tabblad-module maar het heeft geen effect.
Ik kan nog steeds kopiëren/plakken uit andere cel met andere achtergrondkleur waardoor de layout van mijn cellen aangepast wordt en dit wil ik niet.

Het betreft de cellen B5 -> B398 of speelt dit geen rol in de code?

nieuwe voorstellen?

Koen.

 

[edmoor]

Dat cel bereik heb je toch wel aangepast in de code die ik plaatste?
De code is goed en doet precies wat je vroeg.
Plaats daarom altijd een relevant voorbeeld document.

 

[Guillemyn1]

is dit dan de manier om het celbereik aan te passen? dan werkt dit voorlopig niet
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(B5, B398) = "A1" Then
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End Sub

 

[edmoor]

Target.Address is een cel, niet een bereik van cellen en cel A1 hoort daar uiteraard niet bij.
Verdiep je eens in wat het object Target in die zin is.
Volgens je opgave van bereik:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("B5:B398")) Is Nothing Then
        Application.EnableEvents = False
        With Target.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        Application.EnableEvents = True
    End If
End Sub

Klik ook eens op de link in mijn handtekening.

 

[Guillemyn1]

neen, toch nog niet.
sorry, maar ik ben echt een leek in VBA.
Zie bijlage
standaardkleur van de doelcel = lichtgrijs.
In die cellen B5-B398 kunnen ze enkel gegevens schrijven die in ander tabblad opgelijst werden.
maar de gegevens uit ander tabblad hebben andere layout (Zoals B8), vandaar het mogelijk is dat de gebruiker misschien zal willen kopiëren en plakken, maar ik wil niet dat de cellen aangepast worden naar de layout van mijn andere tabblad . Enkel waarden plakken zou moeten mogelijk zijn. (zoals B7)

 

[edmoor]

Plaats een relevant voorbeeld document, niet een plaatje.

 

[Guillemyn1]

aub, in bijlage.

 

[edmoor]

Dan zal je ook het wachtwoord van het VBA project er bij moeten vertellen.

 

[Guillemyn1]

koss

 

[edmoor]

Zo zie je maar waarom het altijd handig is om een relevant voorbeeld te plaatsen:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("B5:B398")) Is Nothing Then
        Application.EnableEvents = False
        With Target.Interior
            .Pattern = 1
            .TintAndShade = -0.249977111117893
            .PatternTintAndShade = 0
            .Color = 12566463
        End With
        Application.EnableEvents = True
    End If
End Sub

De celrand is hierin nog niet meegenomen.

 

[Guillemyn1]

mooi zo !!!
enkel moet er nu nog voor gezorgd worden dat de rand van de doelcel wit blijft, want nu wordt de rode celrand lichtrood als ik kopieer en plak uit het andere tabblad.
kan dit?

 

[edmoor]

Met de randen:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("B5:B398")) Is Nothing Then
        Application.EnableEvents = False
        
        With Target.Interior
            .Pattern = 1
            .TintAndShade = -0.249977111117893
            .PatternTintAndShade = 0
            .Color = 12566463
        End With
        
        Target.Borders(xlDiagonalDown).LineStyle = xlNone
        Target.Borders(xlDiagonalUp).LineStyle = xlNone
        With Target.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = 2
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Target.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = 2
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Target.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 2
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Target.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = 2
            .TintAndShade = 0
            .Weight = xlThin
        End With
        Target.Borders(xlInsideVertical).LineStyle = xlNone
        Target.Borders(xlInsideHorizontal).LineStyle = xlNone
        
        Application.EnableEvents = True
    End If
End Sub

 

[Guillemyn1]

****terend!

prima zo.

hartelijk dank voor uw hulp!!

groeten,
Koen

 

[edmoor]

Graag gedaan.
Alleen nog even je tikfoutje in #15 corrigeren

 

[Jack Nouws]

Een variant met BorderAround

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("B5:B398")) Is Nothing Then
    Application.EnableEvents = False
        
    With Target
      .Interior.Color = RGB(191, 191, 191)
      .BorderAround 1, 2, 2
      .Borders(xlInsideVertical).LineStyle = xlNone
      .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
        
    Application.EnableEvents = True
  End If
End Sub
[/FONT]

 

[edmoor]

Stuk beter :thumb:

 

[Guillemyn1]

Hallo,

dit werk dan toch weer niet.

ik krijg een foutmelding op de gele lijn, 'interior.color...

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B5:B398")) Is Nothing Then
Application.EnableEvents = False

With Target
.Interior.Color = RGB(191, 191, 191)
.BorderAround 1, 2, 2
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With

Application.EnableEvents = True
End If
End Sub

 

[Jack Nouws]

Bij mij werkt het wel.