Besoin d'aide pour un If
Résolu
Utilisateur anonyme
-
Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention -
Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention -
Bonjours,
J'ai une application qui sert à vérifier si des salles sont disponibles pour faire des réunions en fonction d'une date et d'un horaire.
Elle sert aussi à voir si des vidéos projecteurs sont disponibles.
Je voudrais créer une fonction qui test si le vidéo projecteurs est disponible ou pas. L'ancien programmeur avait créé une fonction qui permettait de vérifier si les salles étaient vides.
La voici
Code :
Function isFree(ByVal pStartCol As String, ByVal pStartRow As Integer, ByVal pEndCol As String, ByVal pEndRow As Integer, pFile As String, pSheet As String) As Boolean
Dim free As Boolean
free = True
While (pStartCol <> pEndCol Or pStartRow <> pEndRow) And free = True
If (Workbooks(pFile).Sheets(pSheet).Range(pStartCol & pStartRow).Cells.Interior.ColorIndex > 0 _
And Workbooks(pFile).Sheets(pSheet).Range(pStartCol & pStartRow).Cells.Interior.ColorIndex <> 2 _
And Workbooks(pFile).Sheets(pSheet).Range(pStartCol & pStartRow).Cells.Interior.ColorIndex <> 15) _
Then
free = False
Else
pStartCol = nextCol(pStartCol)
If (pStartCol = "B") Then
pStartRow = pStartRow + 1
End If
End If
Wend
isFree = free
End Function
Il faudrait donc que je réutilise ce code et que je l'adapte. Cependant, ne connaissant pas grand choses au VBA 2003 (je suis étudiant en deuxième année de BTS et que je n'ai appris que le VB.NET) je ne comprend pas très bien le test dans le IF. Quelqu'un pourrait-il m'éclairer sur la question?
Au passage, je souhaiterais faire en sorte que dans une colonne il soit impossible de marquer autre chose que des x, est-ce possible à réaliser ?
Enfin comment fait-on pour tester, dans cette même colonne, s'il y a de x ou que la case est vide. Il faudrait au moins tester si la case est remplie ou pas.
J’ai donc créé cette fonction (en faisant un copier coller tout bête car je ne comprend pas le test mais en modifiant ce que je pouvais)
Code :
Function isFreeVideo(ByVal pStartCol As String, ByVal pStartRow As Integer, ByVal pEndCol As String, ByVal pEndRow As Integer, pFile As String, pSheet As String) As Boolean
Dim free As Boolean
free = True
While (pStartCol <> pEndCol Or pStartRow <> pEndRow) And free = True
If (Workbooks(pFile).Sheets(pSheet).Range(pStartCol & pStartRow).Cells.Interior.ColorIndex > 0 _
And Workbooks(pFile).Sheets(pSheet).Range(pStartCol & pStartRow).Cells.Interior.ColorIndex <> 2 _
And Workbooks(pFile).Sheets(pSheet).Range(pStartCol & pStartRow).Cells.Interior.ColorIndex <> 15) _
Then
free = False
Else
pStartCol = nextVideoCol(pStartCol)
If (pStartCol = "C") Then
pStartRow = pStartRow + 4
End If
End If
Wend
isFreeVideo = free
End Function
Et quand j'exécute il me dit erreur d'exécution '1004' :
Erreur définie par l'application ou par l'objet
et quand je souhaite déboguer il pointe vers
Code :
If (Workbooks(pFile).Sheets(pSheet).Range(pStartCol & pStartRow).Cells.Interior.ColorIndex > 0 _
And Workbooks(pFile).Sheets(pSheet).Range(pStartCol & pStartRow).Cells.Interior.ColorIndex <> 2 _
And Workbooks(pFile).Sheets(pSheet).Range(pStartCol & pStartRow).Cells.Interior.ColorIndex <> 15) _
Then
J'ai une application qui sert à vérifier si des salles sont disponibles pour faire des réunions en fonction d'une date et d'un horaire.
Elle sert aussi à voir si des vidéos projecteurs sont disponibles.
Je voudrais créer une fonction qui test si le vidéo projecteurs est disponible ou pas. L'ancien programmeur avait créé une fonction qui permettait de vérifier si les salles étaient vides.
La voici
Code :
Function isFree(ByVal pStartCol As String, ByVal pStartRow As Integer, ByVal pEndCol As String, ByVal pEndRow As Integer, pFile As String, pSheet As String) As Boolean
Dim free As Boolean
free = True
While (pStartCol <> pEndCol Or pStartRow <> pEndRow) And free = True
If (Workbooks(pFile).Sheets(pSheet).Range(pStartCol & pStartRow).Cells.Interior.ColorIndex > 0 _
And Workbooks(pFile).Sheets(pSheet).Range(pStartCol & pStartRow).Cells.Interior.ColorIndex <> 2 _
And Workbooks(pFile).Sheets(pSheet).Range(pStartCol & pStartRow).Cells.Interior.ColorIndex <> 15) _
Then
free = False
Else
pStartCol = nextCol(pStartCol)
If (pStartCol = "B") Then
pStartRow = pStartRow + 1
End If
End If
Wend
isFree = free
End Function
Il faudrait donc que je réutilise ce code et que je l'adapte. Cependant, ne connaissant pas grand choses au VBA 2003 (je suis étudiant en deuxième année de BTS et que je n'ai appris que le VB.NET) je ne comprend pas très bien le test dans le IF. Quelqu'un pourrait-il m'éclairer sur la question?
Au passage, je souhaiterais faire en sorte que dans une colonne il soit impossible de marquer autre chose que des x, est-ce possible à réaliser ?
Enfin comment fait-on pour tester, dans cette même colonne, s'il y a de x ou que la case est vide. Il faudrait au moins tester si la case est remplie ou pas.
J’ai donc créé cette fonction (en faisant un copier coller tout bête car je ne comprend pas le test mais en modifiant ce que je pouvais)
Code :
Function isFreeVideo(ByVal pStartCol As String, ByVal pStartRow As Integer, ByVal pEndCol As String, ByVal pEndRow As Integer, pFile As String, pSheet As String) As Boolean
Dim free As Boolean
free = True
While (pStartCol <> pEndCol Or pStartRow <> pEndRow) And free = True
If (Workbooks(pFile).Sheets(pSheet).Range(pStartCol & pStartRow).Cells.Interior.ColorIndex > 0 _
And Workbooks(pFile).Sheets(pSheet).Range(pStartCol & pStartRow).Cells.Interior.ColorIndex <> 2 _
And Workbooks(pFile).Sheets(pSheet).Range(pStartCol & pStartRow).Cells.Interior.ColorIndex <> 15) _
Then
free = False
Else
pStartCol = nextVideoCol(pStartCol)
If (pStartCol = "C") Then
pStartRow = pStartRow + 4
End If
End If
Wend
isFreeVideo = free
End Function
Et quand j'exécute il me dit erreur d'exécution '1004' :
Erreur définie par l'application ou par l'objet
et quand je souhaite déboguer il pointe vers
Code :
If (Workbooks(pFile).Sheets(pSheet).Range(pStartCol & pStartRow).Cells.Interior.ColorIndex > 0 _
And Workbooks(pFile).Sheets(pSheet).Range(pStartCol & pStartRow).Cells.Interior.ColorIndex <> 2 _
And Workbooks(pFile).Sheets(pSheet).Range(pStartCol & pStartRow).Cells.Interior.ColorIndex <> 15) _
Then
A voir également:
- Besoin d'aide pour un If
- If exist - Forum Java
- The realtek network controller was not found. if deep sleep mode is enabled please plug the cable ✓ - Forum Pilotes (drivers)
- If char ✓ - Forum Programmation
- The Realtek Network Controller was not found. - Forum Pilotes (drivers)
- Php if multiple conditions ✓ - Forum PHP
15 réponses
Bonjour,
Je veux bien essayer de vous aider, s'il vous est possible de mettre le classeur sur www.cjoint.com se sera plus facile de comprendre exactement le code et de l'adapter à vos besoins.
Je veux bien essayer de vous aider, s'il vous est possible de mettre le classeur sur www.cjoint.com se sera plus facile de comprendre exactement le code et de l'adapter à vos besoins.
Et quand j'exécute il me dit erreur d'exécution '1004' :
l'erreur 1004 est souvent a cause d'une page protégée ou cellule protégée
regarde si il n'y a pas de protections
l'erreur 1004 est souvent a cause d'une page protégée ou cellule protégée
regarde si il n'y a pas de protections
Bonsoir Dante-33,
Concernant, le test dans le IF, il est basé sur le numéro d'index de la couleur de la cellule contrôlée.
Dans se cas il faut que l'index soit: >0 et <> 12 et <> 15 pour que la condition soit TRUE (0=rien,12=jaune sombre et 15=gris25%).
Pour la suite j'attend votre réponse selon poste 1.
Concernant, le test dans le IF, il est basé sur le numéro d'index de la couleur de la cellule contrôlée.
Dans se cas il faut que l'index soit: >0 et <> 12 et <> 15 pour que la condition soit TRUE (0=rien,12=jaune sombre et 15=gris25%).
Pour la suite j'attend votre réponse selon poste 1.
ok merci beaucoup pour le If je t'envoie le fichier joint
Voici l'URL
https://www.cjoint.com/?bhkwbr6NKt
c'est ici que les macro sont stockées
test2 0-AQT_Reservation_Salle.xls
les fichiers
0-AQT_Reservation_Salle.xls et
test 0-AQT_Reservation_Salle.xls
sont des anciennes versions donc ne pas en tenir compte
Voici l'URL
https://www.cjoint.com/?bhkwbr6NKt
c'est ici que les macro sont stockées
test2 0-AQT_Reservation_Salle.xls
les fichiers
0-AQT_Reservation_Salle.xls et
test 0-AQT_Reservation_Salle.xls
sont des anciennes versions donc ne pas en tenir compte
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Bonsoir dante-33,
Je suis sur votre dossier et je tombe sur une erreur de complilation sur la fonction "Function hourToColVideo(pHour As Integer) As String" ! JE CHERCHE ...
Question: Votre document de travail c'est bien "test2 0-AQT_Reservation_Salle.xls" ....?
Et vous recherchez bien les salles libres et aussi les vidéos en même temps ....?
Merci de l'information.
Je suis sur votre dossier et je tombe sur une erreur de complilation sur la fonction "Function hourToColVideo(pHour As Integer) As String" ! JE CHERCHE ...
Question: Votre document de travail c'est bien "test2 0-AQT_Reservation_Salle.xls" ....?
Et vous recherchez bien les salles libres et aussi les vidéos en même temps ....?
Merci de l'information.
Bjr
Je viens de voir le problème
Toute tes fonctions doivent être copier un un Module et non dans une feuille
Je viens de voir le problème
Toute tes fonctions doivent être copier un un Module et non dans une feuille
Bonsoir dante-33,
Votre application fonctionne, dans le classeur "test2 0-AQT_Reservation_Salle.xls" j'ai ajouté une feuille pour votre information.
Vous devez encore compléter l'application pour la partie "Vidéo".
En cas de difficulté vous savez ou me joindre ...!
Le travail est ici : https://www.cjoint.com/?bhxwPAOR3i
Votre application fonctionne, dans le classeur "test2 0-AQT_Reservation_Salle.xls" j'ai ajouté une feuille pour votre information.
Vous devez encore compléter l'application pour la partie "Vidéo".
En cas de difficulté vous savez ou me joindre ...!
Le travail est ici : https://www.cjoint.com/?bhxwPAOR3i
heu je ne sais pas quoi dire tu m'as tout fait heu et bien MERCI BEAUCOUP !!!
P.S.: Sympa le commentaire :)
P.S.: Sympa le commentaire :)
sans vouloir abuser de ta gentilesse je voulais savoir qu'est que tu pense de cette fonction
[code]
Function TesterVideoProjecteur(ByVal p_numVideoProjecteur As Integer, ByVal p_jourDebut As Date, ByVal p_jourFin As Date, ByVal p_HeureDebut As Integer, ByVal p_HeureFin As Integer, ByVal p_File As String, ByVal p_sheet As String) As Boolean
Dim jour As Integer
Dim heure As Integer
Dim ligne As String
'On boucle pour tester chaque jour
For jour = Day(p_jourDebut) To Day(p_jourFin)
ligne = CLng(jour) * 4 + p_numVideoProjecteur + 1
For heure = p_HeureDebut To p_HeureFin
'C'est cela qui plante
If (Workbooks(p_File).Sheets(p_sheet).Cells(ligne, heure).IsEmpty()) Then
'si la ligne est occupée, on retourne faux
TesterVideoProjecteur = False
Else
'sinon on retourne vrai
TesterVideoProjecteur = True
End If
Next heure
Next jour
End Function
[/code]
qui est censé remplacer celle la
[code]
Function isFreeVideo(ByVal pStartCol As String, ByVal pStartRow As Integer, ByVal pEndCol As String, ByVal pEndRow As Integer, pFile As String, pSheet As String) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Returns true if the rooms are free during the specified dates, else returns false '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim free As Boolean
free = True
While (pStartCol <> pEndCol Or pStartRow <> pEndRow) And free = True
If (Workbooks(pFile).Sheets(pSheet).Range(pStartCol & pStartRow).Cells.Interior.ColorIndex > 0 _
And Workbooks(pFile).Sheets(pSheet).Range(pStartCol & pStartRow).Cells.Interior.ColorIndex <> 2 _
And Workbooks(pFile).Sheets(pSheet).Range(pStartCol & pStartRow).Cells.Interior.ColorIndex <> 15) _
Then
free = False
Else
pStartCol = nextColVideo(pStartCol) '--- J'AI MODIFIER: nextVideoCol par nextColVideo
If (pStartCol = "C") Then
pStartRow = pStartRow + 4
End If
End If
Wend
isFreeVideo = free
End Function
[/code]
Je ne sais pas si tu as vu mais le classeur 8-Réservation video.xls n'est pas de la même forme que les autres. J'ai donc créé la première fonction car dans les classeur "normaux" chaque date correspond a une ligne alors que dans le classeur 8-Réservation video.xls une date correspond a 4 lignes
En tout cas encore une fois merci beaucoup !!!!
[code]
Function TesterVideoProjecteur(ByVal p_numVideoProjecteur As Integer, ByVal p_jourDebut As Date, ByVal p_jourFin As Date, ByVal p_HeureDebut As Integer, ByVal p_HeureFin As Integer, ByVal p_File As String, ByVal p_sheet As String) As Boolean
Dim jour As Integer
Dim heure As Integer
Dim ligne As String
'On boucle pour tester chaque jour
For jour = Day(p_jourDebut) To Day(p_jourFin)
ligne = CLng(jour) * 4 + p_numVideoProjecteur + 1
For heure = p_HeureDebut To p_HeureFin
'C'est cela qui plante
If (Workbooks(p_File).Sheets(p_sheet).Cells(ligne, heure).IsEmpty()) Then
'si la ligne est occupée, on retourne faux
TesterVideoProjecteur = False
Else
'sinon on retourne vrai
TesterVideoProjecteur = True
End If
Next heure
Next jour
End Function
[/code]
qui est censé remplacer celle la
[code]
Function isFreeVideo(ByVal pStartCol As String, ByVal pStartRow As Integer, ByVal pEndCol As String, ByVal pEndRow As Integer, pFile As String, pSheet As String) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Returns true if the rooms are free during the specified dates, else returns false '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim free As Boolean
free = True
While (pStartCol <> pEndCol Or pStartRow <> pEndRow) And free = True
If (Workbooks(pFile).Sheets(pSheet).Range(pStartCol & pStartRow).Cells.Interior.ColorIndex > 0 _
And Workbooks(pFile).Sheets(pSheet).Range(pStartCol & pStartRow).Cells.Interior.ColorIndex <> 2 _
And Workbooks(pFile).Sheets(pSheet).Range(pStartCol & pStartRow).Cells.Interior.ColorIndex <> 15) _
Then
free = False
Else
pStartCol = nextColVideo(pStartCol) '--- J'AI MODIFIER: nextVideoCol par nextColVideo
If (pStartCol = "C") Then
pStartRow = pStartRow + 4
End If
End If
Wend
isFreeVideo = free
End Function
[/code]
Je ne sais pas si tu as vu mais le classeur 8-Réservation video.xls n'est pas de la même forme que les autres. J'ai donc créé la première fonction car dans les classeur "normaux" chaque date correspond a une ligne alors que dans le classeur 8-Réservation video.xls une date correspond a 4 lignes
En tout cas encore une fois merci beaucoup !!!!
Bonjour dante-33,
Merci pour l'information.
Je vais regarder votre code, mai dans un premier temps j'ai découvert une erreur pour "Video" (ceci correspond à votre dernière remarque). De ce fait la valeur de divers arguments est fausse et de plus il me semble qu'il manque 2 variables et une fonction pour tenir compte de la position des dates dans le classeur "Video-Room".
Nous pouvons communiquer en direct si vous le voulez !
Je vous donne réponse dans la journée.
.
Merci pour l'information.
Je vais regarder votre code, mai dans un premier temps j'ai découvert une erreur pour "Video" (ceci correspond à votre dernière remarque). De ce fait la valeur de divers arguments est fausse et de plus il me semble qu'il manque 2 variables et une fonction pour tenir compte de la position des dates dans le classeur "Video-Room".
Nous pouvons communiquer en direct si vous le voulez !
Je vous donne réponse dans la journée.
.
Bonjour Dante-33,
Voila cette fois le contrôle pour la Video1 est correct (voir sous Feuil1 en bleu).
Il faut encore faire une boucle pour tenir compte de Video2, 3 et Audio Conf.
Vous remarquez un petit essai qui mentionne le nom "Video 1" à la place de "wahou".
Pour le code proposé, un peut de patience....... merci.
Voici la nouvelle version : https://www.cjoint.com/?bijfIPxo3S
Voila cette fois le contrôle pour la Video1 est correct (voir sous Feuil1 en bleu).
Il faut encore faire une boucle pour tenir compte de Video2, 3 et Audio Conf.
Vous remarquez un petit essai qui mentionne le nom "Video 1" à la place de "wahou".
Pour le code proposé, un peut de patience....... merci.
Voici la nouvelle version : https://www.cjoint.com/?bijfIPxo3S
Bonjour,
Juste en passant, le code qui plante:
remplacer---- If (Workbooks(p_File).Sheets(p_sheet).Cells(ligne, heure).IsEmpty()) Then
par ---- If IsEmpty(Workbooks(p_File).Sheets(p_sheet).Cells(ligne, heure)) Then
Pour la suite je suis absent jusque vers 1700h, alors patience.
Bonne journée.
Juste en passant, le code qui plante:
remplacer---- If (Workbooks(p_File).Sheets(p_sheet).Cells(ligne, heure).IsEmpty()) Then
par ---- If IsEmpty(Workbooks(p_File).Sheets(p_sheet).Cells(ligne, heure)) Then
Pour la suite je suis absent jusque vers 1700h, alors patience.
Bonne journée.
pourriez-vous travailler sur cette version (je n'ai apporté que des amélioration graphique comme par exemple ne pas pouvoir remplir les cases "blanches" , ne pouvoir mettre que un x dans la partie a reserver etc ...
Voici le Cjoint https://www.cjoint.com/?bij7uHi0G0
En tout cas je ne conaissait pas ce site internet il est super pour se faire passer des photos et autres :)
Voici le Cjoint https://www.cjoint.com/?bij7uHi0G0
En tout cas je ne conaissait pas ce site internet il est super pour se faire passer des photos et autres :)
