Aide sur code
#1
Régulier XLPages

Inscription: 05/11/2008

Messages: 53

Système d'exploitation:
PC
Version Excel utilisée:
2003
Posté le : 08-05-2009 16h46

Bonjour,
Dans mon fichier de réservation de salle (ci-joint), dans la 1ère ligne de chaque date, se trouve le matériel à réserver si besoin.
Si une autre personne réserve le même matériel (PC1, PC2) pour la même date, un message s'affiche.
Cependant, j'ai ajouté "PC1 + PC2". Comment faire pour que le même message s'affiche si une personne souhaite réserver l'un des deux.
Merci d'avance pour votre aide.





Pièce jointe:
zip Réservation salles réunions.zip   [ Taille: 35.91 Ko - Téléchargements: 498 ]
Hors Ligne
Rapport   Haut 

Re: Aide sur code
#2
Semi pro XLPages

Inscription: 12/06/2008
De Ile de France Sud

Messages: 145

Système d'exploitation:
PC
Version Excel utilisée:
2003 _ 2010
Posté le : 09-05-2009 17h23
Bonjour à tous
Bonjour Kelly

Dans le fichier joint, le code VBA est protégé, pas facile de t'aider ...

Eric
Hors Ligne
Rapport   Haut 

Re: Aide sur code
#3
Régulier XLPages

Inscription: 05/11/2008

Messages: 53

Système d'exploitation:
PC
Version Excel utilisée:
2003
Posté le : 09-05-2009 18h13
Bonjour,
Voici le code :


Private Sub Worksheet_Change(ByVal Target As Range)
Dim C As Byte
Dim KO As Boolean
    If Target(1).Value = "" Then Exit Sub
    If Not Application.Intersect(Target, Cells.SpecialCells(xlCellTypeAllValidation)) Is Nothing Then
        With Target
            If .Validation.Formula1 = "=Matériel" Then
                Select Case Application.CountIf(.EntireRow, .Value)
                Case Is > 2
                    KO = True
                Case Is > 1
                    For C = 3 To 13
                        If Cells(.Row, C).Value = .Value And C <> .Column Then
                            KO = Cells(2, C).Value = Cells(2, .Column).Value
                            Exit For
                        End If
                    Next C
                End Select
            End If
        End With
    End If
    If KO Then
        MsgBox "Ce matériel est déjà réservé sur cette période !"
        Application.Undo
    End If
End Sub


Avec toutes mes excuses.
Merci


Hors Ligne
Rapport   Haut 

Re: Aide sur code
#4
Régulier XLPages

Inscription: 05/11/2008

Messages: 53

Système d'exploitation:
PC
Version Excel utilisée:
2003
Posté le : 09-05-2009 18h20

Voici le fichier sans mot de passe cette fois...

Merci pour votre aide !

Pièce jointe:
zip Réservation salles réunions.zip   [ Taille: 35.66 Ko - Téléchargements: 504 ]
Hors Ligne
Rapport   Haut 

Re: Aide sur code
#5
Semi pro XLPages

Inscription: 12/06/2008
De Ile de France Sud

Messages: 145

Système d'exploitation:
PC
Version Excel utilisée:
2003 _ 2010
Posté le : 12-05-2009 00h01
Bonsoir à tous
Bonsoir Kelly

Tu peux ajouter ceci :
   With Worksheets("Janvier").Range(maligne)   'modifier Janvier, maligne = Target(1).Row & ":" & Target(1).Row
    Set d = .Find(a, LookIn:=xlValues, Lookat:=xlPart)   'a = variable
recherchéeTarget(1).Value
        If Not d Is Nothing Then
            KO = True
        End If
    End With

Eric


Hors Ligne
Rapport   Haut 

Re: Aide sur code
#6
Régulier XLPages

Inscription: 05/11/2008

Messages: 53

Système d'exploitation:
PC
Version Excel utilisée:
2003
Posté le : 12-05-2009 00h39
Bonsoir à tous,
Bonsoir Eric,
Merci pour ta réponse.
Seulement cela ne fonctionne pas. Je dois mal insérer le code !
Ou dois-je l'insérer dans mon code actuel ?
Y a til quelque chose à modifier ?
Pourrais je le copier sur toutes mes feuilles (janvier à décembre)?
Désolé pour toutes ses questions.
Merci d'avance.

Hors Ligne
Rapport   Haut 

Re: Aide sur code
#7
Semi pro XLPages

Inscription: 12/06/2008
De Ile de France Sud

Messages: 145

Système d'exploitation:
PC
Version Excel utilisée:
2003 _ 2010
Posté le : 12-05-2009 19h46
Bonsoir à tous
Bonsoir Kelly

Ce que je t'ai déposé ne fonctionne pas pour tous les cas. Celui-ci, j'ai pu le tester et il a l'air de fonctionner. J'espère que c'est ce que tu recherches.
Tu déposes dans un module standard ceci :
Option Explicit

Public KO As Boolean
Public ma_feuille As String
Public macol
Public maligne
Public valeur_cellule 'As String

Sub recherche()

Dim a As Integer
Dim i As Integer

Select Case macol
    Case 3, 7, 11, 15, 19, 23
        a = 3
    Case 5, 9, 13, 17, 21, 25
        a = 5
End Select

For i = 0 To 5
    If macol <> a + (i * 4) Then
        If Worksheets(ma_feuille).Cells(4, a + (i * 4)) <> "" Then
            If InStr(valeur_cellule, CStr(Worksheets(ma_feuille).Cells(4, a + (i * 4)))) <> 0 Then MsgBox "Ce mat�riel est d�j� r�serv� sur cette p�riode !": Exit Sub
            If InStr(CStr(Worksheets(ma_feuille).Cells(4, a + (i * 4))), valeur_cellule) <> 0 Then MsgBox "Ce mat�riel est d�j� r�serv� sur cette p�riode !": Exit Sub
        End If
    End If
Next i

End Sub
 

et dans "Private Sub Worksheet_Change" de chaque feuille :
Private Sub Worksheet_Change(ByVal Target As Range)
If Target(1).Value = "" Then Exit Sub

ma_feuille = ActiveSheet.Name
macol = Target.Column
maligne = Target.Row
valeur_cellule = Target.Value

recherche
End Sub
 

On peut améliorer, mais je n'ai pas eu le temps.

Dis nous

Eric
Hors Ligne
Rapport   Haut 

Re: Aide sur code
#8
Régulier XLPages

Inscription: 05/11/2008

Messages: 53

Système d'exploitation:
PC
Version Excel utilisée:
2003
Posté le : 13-05-2009 18h01
Bonjour à tous,
Bonjour Eric,

Je viens d'essayer le code.
Malheureusement, cela ne fonctionne pas partout et pas tout le temps ! J'ai testé pour le 2ème jour par exemple, ça ne marche pas et quand je choisis un tout autre matériel un autre jour, cela me met le message.
De plus, il faut que j'ajoute d'autres matériels avec le PC1 et le PC2 que j'ai inséré dans le fichier joint.
Comment faire ?

Aidez-moi!
Merci d'avance pour votre aide précieuse.

Pièce jointe:
zip Réservation salles réunions1.zip   [ Taille: 38.54 Ko - Téléchargements: 499 ]
Hors Ligne
Rapport   Haut 

Re: Aide sur code
#9
Semi pro XLPages

Inscription: 12/06/2008
De Ile de France Sud

Messages: 145

Système d'exploitation:
PC
Version Excel utilisée:
2003 _ 2010
Posté le : 13-05-2009 20h17
Bonsoir à tous
Bonsoir Kelly

Le code du module modifié :
ption Explicit

Public KO As Boolean
Public ma_feuille As String
Public macol
Public maligne
Public trouve As Integer
Public valeur_cellule 'As String

Sub recherche()

Dim a As Integer
Dim i As Integer
Dim pos As Integer

Select Case macol
    Case 3, 7, 11, 15, 19, 23
        a = 3
    Case 5, 9, 13, 17, 21, 25
        a = 5
End Select

For i = 0 To 5
    If macol <> a + (i * 4) Then
        If Worksheets(ma_feuille).Cells(maligne, a + (i * 4)) <> "" Then
            If InStr(valeur_cellule, CStr(Worksheets(ma_feuille).Cells(maligne, a + (i * 4)))) <> 0 Then MsgBox "Ce mat�riel est d�j� r�serv� sur cette p�riode !": trouve = 1: Exit Sub
            If InStr(CStr(Worksheets(ma_feuille).Cells(maligne, a + (i * 4))), valeur_cellule) <> 0 Then MsgBox "Ce mat�riel est d�j� r�serv� sur cette p�riode !": trouve = 1: Exit Sub
        End If
    End If
Next i

End Sub

Sub materiel()
Dim i As Integer
Dim lalong As Integer
Dim valeur_cellule_intermediaire
Dim pos As Integer

If InStr(valeur_cellule, "+") <> 0 Then
    valeur_cellule_intermediaire = valeur_cellule
    lalong = Len(valeur_cellule)
    pos = InStr(valeur_cellule, "+")
    valeur_cellule = Left(valeur_cellule_intermediaire, pos - 2)
    recherche
    If trouve = 1 Then Exit Sub
    valeur_cellule = Right(valeur_cellule_intermediaire, lalong - pos - 1)
    recherche
Else
    recherche
End If

End Sub
 

Le code de la Feuille modifié :
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target(1).Value = "" Then Exit Sub

ma_feuille = ActiveSheet.Name
macol = Target.Column
maligne = Target.Row
valeur_cellule = Target.Value

'recherche
materiel

End Sub

Si tu dois ajouter d'autres matériels, il faudra peut-être ajuster. Pour l'instant, cela doit (!) fonctionner avec PC1 et autre PC1 + sono, cad avec un + entouré d'espaces.

Eric
Hors Ligne
Rapport   Haut 

Re: Aide sur code
#10
Régulier XLPages

Inscription: 05/11/2008

Messages: 53

Système d'exploitation:
PC
Version Excel utilisée:
2003
Posté le : 14-05-2009 00h38
Bonsoir à tous,
Bonsoir Eric,

C'est formidable ça fonctionne !
Cependant, y a t il un moyen si on choisit une nouvelle fois "PC2" et que le message s'affiche, que l'option choisie disparaisse de la cellule pour que la personne opte pour un autre matériel !

Quand tu auras un peu de temps, pourras-tu m'expliquer un peu le code car je ne comprends pas tout !!

En tout cas, merci beaucoup pour ton aide.

Hors Ligne
Rapport   Haut 


Vous pouvez voir les sujets.
Vous ne pouvez pas débuter de nouveaux sujets.
Vous ne pouvez pas répondre aux contributions.
Vous ne pouvez pas éditer vos contributions.
Vous ne pouvez pas effacez vos contributions.
Vous ne pouvez pas ajouter de nouveaux sondages.
Vous ne pouvez pas voter en sondage.
Vous ne pouvez pas attacher des fichiers à vos contributions.
Vous ne pouvez pas poster sans approbation.

[Recherche avancée]


Qui consulte actuellement ce sujet ?   1 Utilisateur(s) anonymes