Demande d'aide pour "aditionner" deux codes

[lanoe]

Bonjour,

En cherchant sur le forum, j'ai trouvé deux codes que je veux liéer pour qu'ils interviennent sur la mëme feuille en "Option Explicit"

Mais compétence sont trop limité pour y parvenir.


Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 11 Then
Dim Couleur As Integer, I As Integer, R As Long
R = Target.Row

Select Case UCase(Target)
Case "A": Couleur = 36
Case "B": Couleur = 46
Case "C": Couleur = 34
Case "D": Couleur = 35
Case " ": Couleur = 0
Case Else: Couleur = 0
End Select
For I = 1 To 13
Cells(R, I).Interior.ColorIndex = Couleur
Next
End If
End Sub

ET...

Private Sub Worksheet_Change(ByVal Target As Range)
'Si la cellule n'est pas dans la plage concernée on sort
If Intersect(Target, Range("A4:A6000")) Is Nothing Then Exit Sub
'Si la cellule n'est pas vide
If Target.Text <> vbNullString Then
'La cellule de droite= jour+1
Target.Offset(, 1) = Date + 1
Else
'Sinon on efface cellule de droite
Target.Offset(, 1).ClearContents
End If
End Sub

Merci d'avance
Lanoe

 

[Cousinhub]

Re : Demande d'aide pour "aditionner" deux codes

Bonsoir,

peut-être :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Couleur As Integer, I As Integer, R As Long
If Target.Column = 11 Then
    R = Target.Row
    Select Case UCase(Target)
        Case "A": Couleur = 36
        Case "B": Couleur = 46
        Case "C": Couleur = 34
        Case "D": Couleur = 35
        Case Else: Couleur = 0
    End Select
    Cells(R, 1).Resize(1, 13).Interior.ColorIndex = Couleur
ElseIf Intersect(Target, Range("A4:A6000")) Is Nothing Then Exit Sub
    If Target.Text <> vbNullString Then
        Target.Offset(, 1) = Date + 1
    Else
        Target.Offset(, 1).ClearContents
    End If
End If
End Sub

Edit : Pense à mettre tes codes entre balises
pour ce faire, tu cliques sur le #, il apparaitra [code ]ICI [ /code], et tu colles le code au milieu

 

[lanoe]

Re : Demande d'aide pour "aditionner" deux codes

Bonjour,

J'ai un soucis je n'arrive pas à coller le code Cf:[code ]ICI [ /code].

Peux-tu me le mettre sur un fichier?

Merci d'avance
Lanoe

 

[Cousinhub]

Re : Demande d'aide pour "aditionner" deux codes

Re,

Euh, c'était juste une indication

Lorsque tu rédiges un message, pour mettre du code dans ton message, il est préférable de le mettre entre balises

D'une part, c'est beaucoup plus lisible, et d'autre part, lorsqu'on fait un copier coller, les retours à la ligne sont respectés, comme si on copiait d'un module

Fais un copier coller du code fourni, et dis quoi

 

[lanoe]

Re : Demande d'aide pour "aditionner" deux codes

Re-

La premiere partie du code fonctionne bien par contre la 2eme ou la date+1 doit s'inscrire en colonne B si il y a qq chose en A ne fonctionne pas

je prépare un fichier
Lanoe

 

[Cousinhub]

Re : Demande d'aide pour "aditionner" deux codes

Re,

effectivement, je n'avais point essayé...

essaie :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Couleur As Integer, I As Integer, R As Long
If Target.Column = 11 Then
    R = Target.Row
    Select Case UCase(Target)
        Case "A": Couleur = 36
        Case "B": Couleur = 46
        Case "C": Couleur = 34
        Case "D": Couleur = 35
        Case Else: Couleur = 0
    End Select
    Cells(R, 1).Resize(1, 13).Interior.ColorIndex = Couleur
ElseIf Not Intersect(Target, Range("A4:A6000")) Is Nothing Then
    If Target.Text <> vbNullString Then
        Target.Offset(, 1) = Date + 1
    Else
        Target.Offset(, 1).ClearContents
    End If
End If
End Sub

 

[lanoe]

Re : Demande d'aide pour "aditionner" deux codes

Re,

C'est bon cela fonctionne, si je peux je rajoute une couche avec un autre code que j'aimerais retrouver sur cette feuille:


Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Sub pleinecran_ClicK()
Dim hdle As Long
Dim cmdB As CommandBar
If Application.DisplayFullScreen = True Then
hdle = FindWindowA("Shell_traywnd", "")
SetWindowPos hdle, 0, 0, 0, 0, 0, &H40
Application.DisplayFullScreen = False
For Each cmdB In Application.CommandBars
cmdB.Enabled = True
Next cmdB
pleinecran.Caption = "Plein écran"
ActiveCell.Select
Else: hdle = FindWindowA("Shell_traywnd", "")
SetWindowPos hdle, 0, 0, 0, 0, 0, &H80
Application.DisplayFullScreen = True
For Each cmdB In Application.CommandBars
cmdB.Enabled = False
Next cmdB
pleinecran.Caption = "Ecran normal"
ActiveCell.Select
End If
End Sub

lanoe

 

[Cousinhub]

Re : Demande d'aide pour "aditionner" deux codes

Re-,

tu n'as pas compris mon message?

Mets ton code entre balise

Tu as vu, dans mes réponses, le code était dans une boîte bleue......

Lorsque tu rédiges un message, en haut, tu as un #

si tu cliques dessus, tu peux ensuite insérer ton code entre les balises, comme je te l'ai montré

 

[Staple1600]

Re : Demande d'aide pour "aditionner" deux codes

Bonjour


Pour aider bhbh à t'aider à comprendre ce qu'il veut te dire

Excel Downloads Forums - Liste des balises BB


edition: bonsoir bhbh

 

[lanoe]

Re : Demande d'aide pour "aditionner" deux codes

Re-
Avec le lien de Staple1600, j'ai compris.

merci à vous deux
lanoe

 

[Cousinhub]

Re : Demande d'aide pour "aditionner" deux codes

Re,

je viens de lire ton code (pas facile)

tu interviens sur les barres d'outils, la modification de l'écran, bref, tout ce qui pourrait faire le bonheur d'un apprenti excellien

Tu peux faire ce que tu veux, pour ma part, j'évite d'y toucher

Fais une recherche sur ce forum

le nombre de questions concernant la réhabilitation d'excel est éloquent

A toi de voir

 

[Staple1600]

Re : Demande d'aide pour "aditionner" deux codes

Re




Dans ce cas, lanoe , tu peux , stp, éditer tes messages contenant du code VBA
et y insérer la balise CODE

 

[Cousinhub]

Re : Demande d'aide pour "aditionner" deux codes

Re-,

Tu veux quand même agir sur tes barres d'outils?

juste avant, lis ce fil : HELP

Et réfléchis bien...

 

[lanoe]

Re : Demande d'aide pour "aditionner" deux codes

Re,

je suis novice en VBA j'ai trouvé se code par hasard sur le forum je le trouvais bien utile. Mais éffectivement cela pose question.

merci pour l'info,

lanoe