VBA Conflict.

[Roma]

Beste forumgebruikers,

Ik heb van Harry een code om bepaalde cellen op bepaalde tabbladen een kleur te geven.
Sind gisteren heb ik van Niels een code om een Combobox in installeren.

In beide gevallen gaat het om dezelfde tabbladen.
Ik heb de code van Niels in het bestand gezet maar geeft een probleem met de code van Harry.

Wie kan mij helpen om dit probleem op te lossen? ik heb alles geprobeerd maar het lukt mij niet.

De code van Niels:

Private Sub CommandButton1_Click()
If ComboBox1.Value <> "" Then
sh = Array("blad2", "blad3", "blad4", "blad5")
For i = 0 To UBound(sh)
With Sheets(sh(i))
    .Visible = True
    .unprotect""
    .Range("C" & ComboBox1.ListIndex + 96).Resize(1, 31).ClearContents
    .Range("C" & ComboBox1.ListIndex + 53).Resize(1, 31).ClearContents
    .Range("C" & ComboBox1.ListIndex + 9).Resize(1, 31).ClearContents
    .protect
    .Visible = False
End With
Next
End If
End Sub

en hier is de code van Harry:

'Dienstcodes kleuren
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If WorksheetFunction.Or(Sh.Name = "KWART 1", Sh.Name = "KWART 2", Sh.Name = "KWART 3", Sh.Name = "KWART 4") Then
[COLOR="#FF0000"]If Not Intersect(Target, Range("C9:AG43, C53:AG87, C96:AG130")) Is Nothing Then[/COLOR]    
With Sheets("Kleurencode").Range("F7:L35")
        Set c = .Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
       Sh.Unprotect ""
        If Not c Is Nothing Then
            Target.Interior.Color = c.Interior.Color
'            Target.Offset(44).Interior.Color = c.Interior.Color
'            Target.Offset(87).Interior.Color = c.Interior.Color
        Else
            Target.Interior.Color = xlNone
          MsgBox "Je hebt een ongeldige code gekozen." & vbNewLine & "Kies een andere code.", vbExclamation, "Kleurencode."
            Target.Value = ""
       End If
       Sh.Protect ""
    End With
  End If
 End If
End Sub

De foutmelding is: Methode intersect van Object_Globl is mislukt

Alvast bedankt voor jullie medewerking

 

[Roma]

Wie o wie wil mij helpen.
Ik ben nog geen halfjaar bezig met VBA en heb ondertussen veel te danken aan dezez site.
Nu heb ik van alles geprobeerd en gelezen maar het lukt mij niet.

Onderstaande code geeft een fotmelding.
Maar als ik deze uitschakel werkt het wel maar dan kan ik op de rest van de tabbladen niets meer invullen door de beveiliging die is ingebouwd. Nu is het wel de bedoeling dat bij enkele cellen wel wat ingevoerd moet worden.
wie kan mij aan een oplossing helpen

If Not Intersect(target, Range("C9:AG43, C53:AG87, C96:AG130")) Is Nothing Then

In de bijlage een uitgekleed (maar 1 KWART ingevuld)voorbeeld.

Bij voorbaat dank
Ron

 

[Niels28]

Private Sub CommandButton1_Click()
Application.EnableEvents = False
If ComboBox1.Value <> "" Then
sh = Array("blad2", "blad3", "blad4", "blad5")
For i = 0 To UBound(sh)
With Sheets(sh(i))
    .Visible = True
    .unprotect""
    .Range("C" & ComboBox1.ListIndex + 96).Resize(1, 31).ClearContents
    .Range("C" & ComboBox1.ListIndex + 53).Resize(1, 31).ClearContents
    .Range("C" & ComboBox1.ListIndex + 9).Resize(1, 31).ClearContents
    .protect
    .Visible = False
End With
Next
End If
Application.EnableEvents = true
End Sub

Niels

 

[Roma]

Niels,
Super bedankt ik zat in een totaal verkeerde code te zoeken.
Het is wel jammer dat de kleuren blijven staan maar ik ben hier zeer content mee.
Bedankt

 

[Niels28]

nog wel even je tabbladen weer in de array plaatsen, die heb ik eruit gehaald om te testen.

Private Sub CommandButton1_Click()
Application.EnableEvents = False
If ComboBox1.Value <> "" Then
Sh = Array("KWART 1")
For i = 0 To UBound(Sh)
Application.ScreenUpdating = False
With Sheets(Sh(i))
    ''.Visible = True
    ActiveSheet.Unprotect ""
    .Range("C" & ComboBox1.ListIndex + 96).Resize(1, 31).ClearContents
       .Range("C" & ComboBox1.ListIndex + 96).Resize(1, 31).Interior.Pattern = xlNone
    .Range("C" & ComboBox1.ListIndex + 53).Resize(1, 31).ClearContents
    .Range("C" & ComboBox1.ListIndex + 53).Resize(1, 31).Interior.Pattern = xlNone
    .Range("C" & ComboBox1.ListIndex + 9).Resize(1, 31).ClearContents
    .Range("C" & ComboBox1.ListIndex + 9).Resize(1, 31).Interior.Pattern = xlNone
    ''.Visible = False
    Application.ScreenUpdating = True
End With
Next

End If
Application.EnableEvents = True
Unload Me
End Sub

Niels

 

[Roma]

Had ik al gedaan
Ron

 

[Niels28]

Had ik al gedaan
Ron

????

Ik geef het alleen aan omdat de macro in de laatste post ook de kleur verwijderd en daar heb ik de tabbladen uit de array in de macro verwijderd.

Niels

 

[Roma]

Niels
Had ik gezien en veranderd
Super bedankt
Ron

 

[Roma]

Niels
Hij loopt hier op vast

.Range("C" & ComboBox1.ListIndex + 9).Resize(1, 31).Interior.Pattern = xlNone

Ik heb ook geprobeerd Interior.color. toe te voegen maar dat werkt niet

 

[Roma]

Probleem opgelost
Spatie te veel
Niels bedankt voor je bijdrage
Ron