Besoin d'aide pour un IF

**dante33** · 04/01/2008, 14h44

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
 
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 :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
 
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 :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
        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

**Jean-Philippe André** · 04/01/2008, 15h22

bonjour,
peux-tu nous donner le code qui fait appel à cette fonction stp ?

**dante33** · 04/01/2008, 15h24

oui c'est celui la

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
 
Sub displayFreeRooms_Click()
 
    Dim startDate As Date
    Dim startHour As Integer
    Dim endDate As Date
    Dim endHour As Integer
    Dim startRow As Integer
    Dim endRow As Integer
    Dim startCol As String
    Dim startVideoCol As String
    Dim endCol As String
    Dim endVideoCol As String
    Dim startMonth As String
    Dim endMonth As String
    Dim free As Boolean
    Dim hasMoreFiles As Boolean
    Dim main_file_name As String
    Dim main_sheet_name As String
 
    main_file_name = ActiveWorkbook.Name
    main_sheet_name = ActiveSheet.Name
 
    'Retrieve the dates from the form filled by the user
    startDate = Range("C7").Value
    endDate = Range("C11").Value
    startHour = Range("C9").Value
    endHour = Range("C13").Value
 
    'Transform the dates into rows and columns
    startRow = dateToRow(startDate)
    endRow = dateToRow(endDate)
    startCol = hourToCol(startHour)
    startVideoCol = hourToVideoCol(startHour)
    endCol = hourToCol(endHour)
    endVideoCol = hourToVideoCol(endHour)
 
    hasMoreFiles = True
    currentFile = "none"
    startMonth = dateToMonth(startDate)
    endMonth = dateToMonth(endDate)
 
    If (startMonth = endMonth) Then
 
        'Unprotect the sheet in order to execute the macro
        ActiveSheet.Unprotect
 
        'Opens both meeting rooms' files and video rooms' files
        openFile = openFiles()
 
        'Clears the previous search if any
        nextFreeRow = 8
        Clear = clearFreeRooms(main_file_name, main_sheet_name)
        Clear = clearFreeVideo(main_file_name, main_sheet_name)
        nextFreeRow = 8
 
        'On rend le bouton reserver inclickable
        btnReserver.Enabled = False
 
        'Searches free meeting rooms
        While (hasMoreFiles = True)
            hasMoreFiles = nextFile()
            free = isFree(startCol, startRow, endCol, endRow, currentFile, startMonth)
            If free = True Then
                room = addRoom(main_file_name, main_sheet_name)
                'S'il y a une salle libre, on rend le bouton clickable
                btnReserver.Enabled = True
            End If
        Wend
 
        nextFreeRow = 8
 
        ' C'est cette partie !!!
        'Searches for free video rooms
        currentFile = video_room
        free = isFreeVideo(startCol, startRow, endCol, endRow, currentFile, startMonth)
        If free = True Then
                room = addVideoRoom()
        End If
 
        'Close both meeting rooms' files and video rooms' files
        closeFile = closeFiles()
 
        'Protect the sheet so the users can't modify it
        'ActiveSheet.Protect
 
    Else
 
        MsgBox ("Vous devez renseigner deux dates du même mois")
 
    End If
 
End Sub

**Jean-Philippe André** · 04/01/2008, 15h31

d'accord,
as-tu un fichier qui s'appelle "none" ?

**dante33** · 04/01/2008, 15h34

non mais regarde dans le code aprés il avait fait

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
currentFile = video_room

et plus haut j'ai rajouté

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Const video_room As String ="LeNomDeMonFichier"

le nom de mon fichier est juste je l'ai vérifié

**Jean-Philippe André** · 04/01/2008, 15h50

je crois avoir trouvé remplace tes range par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

range("""" & pStartCol & pStartRow &"""")

Besoin d'aide pour un IF

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager