thyphonfalcon
Messages postés
41
Date d'inscription
vendredi 27 octobre 2006
Statut
Membre
Dernière intervention
12 mai 2007
11 mai 2007 à 21:13
Bonjour,
Voici le code une partie du code
Option Explicit
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private DicIcones As Scripting.Dictionary
Dim db As Database
Dim rs As Recordset
Dim sql As String
Public DocE As Object
Private Sub CDernier_Click()
rs.MoveLast
Text1.Text = rs!RMC
Text2.Text = rs!Container
Text3.Text = rs!Demandeur
Text4.Text = rs!Date
Text5.Text = rs!Quantité
Text6.Text = rs!Description_1
Text7.Text = rs!Defaut_1
Text8.Text = rs!Description_2
Text9.Text = rs!Defaut_2
Text10.Text = rs!Description_3
Text11.Text = rs!Defaut_3
Text12.Text = rs!Description_4
Text13.Text = rs!Defaut_4
Text14.Text = rs!Description_5
Text15.Text = rs!Defaut_5
Text16.Text = rs!Description_6
Text17.Text = rs!Defaut_6
Text18.Text = rs!Description_7
Text19.Text = rs!Defaut_7
Text20.Text = rs!Description_8
Text21.Text = rs!Defaut_8
Text22.Text = rs!Description_9
Text23.Text = rs!Defaut_9
Text25.Text = rs!Defaut_10
Text24.Text = rs!Description_10
Text29.Text = rs!Defaut_11
Text28.Text = rs!Description_11
Text31.Text = rs!Defaut_12
Text30.Text = rs!Description_12
Text26.Text = rs!N°
End Sub
Private Sub CEnregistrer_Click()
rs.AddNew 'Ajoute un nouvel enregistrement
rs!RMC = Text26.Text
rs!RMC = Text1.Text
rs!Container = Text2.Text
rs!Demandeur = Text3.Text
rs!Date = Text4.Text
rs!Quantité = Text5.Text
rs!Description_1 = Text6.Text
rs!Defaut_1 = Text7.Text
rs!Description_2 = Text8.Text
rs!Defaut_2 = Text9.Text
rs!Description_3 = Text10.Text
rs!Defaut_3 = Text11.Text
rs!Description_4 = Text12.Text
rs!Defaut_4 = Text13.Text
rs!Description_5 = Text14.Text
rs!Defaut_5 = Text15.Text
rs!Description_6 = Text16.Text
rs!Defaut_6 = Text17.Text
rs!Description_7 = Text18.Text
rs!Defaut_7 = Text19.Text
rs!Description_8 = Text20.Text
rs!Defaut_8 = Text21.Text
rs!Description_9 = Text22.Text
rs!Defaut_9 = Text23.Text
rs!Description_10 = Text24.Text
rs!Defaut_10 = Text25.Text
rs!Description_11 = Text28.Text
rs!Defaut_11 = Text29.Text
rs!Description_12 = Text30.Text
rs!Defaut_12 = Text31.Text
rs.Update
Text27.Text = rs.RecordCount
CDernier_Click
End Sub
Private Sub CNouveau_Click()
Dim LngNouvelleValeur As Long
Text26.Text = rs.Fields("N°").DefaultValue
Text1.Text = rs.Fields("RMC").DefaultValue
Text2.Text = rs.Fields("Container").DefaultValue
Text3.Text = rs.Fields("Demandeur").DefaultValue
Text4.Text = rs.Fields("Date").DefaultValue
Text5.Text = rs.Fields("Quantité").DefaultValue
Text6.Text = rs.Fields("Description_1").DefaultValue
Text7.Text = rs.Fields("Defaut_1").DefaultValue
Text8.Text = rs.Fields("Description_2").DefaultValue
Text9.Text = rs.Fields("Defaut_2").DefaultValue
Text10.Text = rs.Fields("Description_3").DefaultValue
Text11.Text = rs.Fields("Defaut_3").DefaultValue
Text12.Text = rs.Fields("Description_4").DefaultValue
Text13.Text = rs.Fields("Defaut_4").DefaultValue
Text14.Text = rs.Fields("Description_5").DefaultValue
Text15.Text = rs.Fields("Defaut_5").DefaultValue
Text16.Text = rs.Fields("Description_6").DefaultValue
Text17.Text = rs.Fields("Defaut_6").DefaultValue
Text18.Text = rs.Fields("Description_7").DefaultValue
Text19.Text = rs.Fields("Defaut_7").DefaultValue
Text20.Text = rs.Fields("Description_8").DefaultValue
Text21.Text = rs.Fields("Defaut_8").DefaultValue
Text22.Text = rs.Fields("Description_9").DefaultValue
Text23.Text = rs.Fields("Defaut_9").DefaultValue
Text24.Text = rs.Fields("Description_10").DefaultValue
Text25.Text = rs.Fields("Defaut_10").DefaultValue
Text28.Text = rs.Fields("Description_11").DefaultValue
Text29.Text = rs.Fields("Defaut_11").Value
Text30.Text = rs.Fields("Description_12").DefaultValue
Text31.Text = rs.Fields("Defaut_12").Value
TreeViewFile.SetFocus
End Sub
Private Sub CPrecedent_Click()
rs.MovePrevious
If rs.BOF = True Then
rs.MoveFirst
End If
Text1.Text = rs!RMC
Text2.Text = rs!Container
Text3.Text = rs!Demandeur
Text4.Text = rs!Date
Text5.Text = rs!Quantité
Text6.Text = rs!Description_1
Text7.Text = rs!Defaut_1
Text8.Text = rs!Description_2
Text9.Text = rs!Defaut_2
Text10.Text = rs!Description_3
Text11.Text = rs!Defaut_3
Text12.Text = rs!Description_4
Text13.Text = rs!Defaut_4
Text14.Text = rs!Description_5
Text15.Text = rs!Defaut_5
Text16.Text = rs!Description_6
Text17.Text = rs!Defaut_6
Text18.Text = rs!Description_7
Text19.Text = rs!Defaut_7
Text20.Text = rs!Description_8
Text21.Text = rs!Defaut_8
Text22.Text = rs!Description_9
Text23.Text = rs!Defaut_9
Text24.Text = rs!Description_10
Text25.Text = rs!Defaut_10
Text26.Text = rs!N°
Text28.Text = rs!Description_11
Text29.Text = rs!Defaut_11
Text30.Text = rs!Description_12
Text31.Text = rs!Defaut_12
Text27.Text = rs.RecordCount
End Sub
Private Sub CPremier_Click()
rs.MoveFirst
Text1.Text = rs!RMC
Text2.Text = rs!Container
Text3.Text = rs!Demandeur
Text4.Text = rs!Date
Text5.Text = rs!Quantité
Text6.Text = rs!Description_1
Text7.Text = rs!Defaut_1
Text8.Text = rs!Description_2
Text9.Text = rs!Defaut_2
Text10.Text = rs!Description_3
Text11.Text = rs!Defaut_3
Text12.Text = rs!Description_4
Text13.Text = rs!Defaut_4
Text14.Text = rs!Description_5
Text15.Text = rs!Defaut_5
Text16.Text = rs!Description_6
Text17.Text = rs!Defaut_6
Text18.Text = rs!Description_7
Text19.Text = rs!Defaut_7
Text20.Text = rs!Description_8
Text21.Text = rs!Defaut_8
Text22.Text = rs!Description_9
Text23.Text = rs!Defaut_9
Text24.Text = rs!Description_10
Text25.Text = rs!Defaut_10
Text26.Text = rs!N°
Text28.Text = rs!Description_11
Text29.Text = rs!Defaut_11
Text30.Text = rs!Description_12
Text31.Text = rs!Defaut_12
End Sub
Private Sub CQuitter_Click()
Unload Me
End Sub
Private Sub CSuivant_Click()
On Error Resume Next
rs.MoveNext
If rs.EOF = True Then
rs.MoveLast
End If
Text1.Text = rs!RMC
Text2.Text = rs!Container
Text3.Text = rs!Demandeur
Text4.Text = rs!Date
Text5.Text = rs!Quantité
Text6.Text = rs!Description_1
Text7.Text = rs!Defaut_1
Text8.Text = rs!Description_2
Text9.Text = rs!Defaut_2
Text10.Text = rs!Description_3
Text11.Text = rs!Defaut_3
Text12.Text = rs!Description_4
Text13.Text = rs!Defaut_4
Text14.Text = rs!Description_5
Text15.Text = rs!Defaut_5
Text16.Text = rs!Description_6
Text17.Text = rs!Defaut_6
Text18.Text = rs!Description_7
Text19.Text = rs!Defaut_7
Text20.Text = rs!Description_8
Text21.Text = rs!Defaut_8
Text22.Text = rs!Description_9
Text23.Text = rs!Defaut_9
Text24.Text = rs!Description_10
Text25.Text = rs!Defaut_10
Text26.Text = rs!N°
Text28.Text = rs!Description_11
Text29.Text = rs!Defaut_11
Text30.Text = rs!Description_12
Text31.Text = rs!Defaut_12
End Sub
Private Sub Form_Load()
On Error GoTo Erreurs
Dim strCommand As String
Dim strDestination As String
Set DicIcones = CreateObject("Scripting.Dictionary")
With DicIcones
.Add "xls", 3
.Add "mdb", 19
End With
strCommand = CStr(Command)
If strCommand = vbNullString Then
strDestination = Left(Drive.Drive, 2)
Else
strDestination = Right(strCommand, Len(strCommand) - 1)
strDestination = Left(strDestination, Len(strDestination) - 1) If Right(strDestination, 1) "" Then strDestination Left(strDestination, Len(strDestination) - 1)
End If
BuildDriveTree (strDestination)
Me.Show
OuvDB_Click
Text27.Text = rs.RecordCount
Exit Sub
Erreurs:
MsgBox "Voici le chemin spécifié : " & strDestination
End Sub
Private Sub BuildDriveTree(p_strDestination As String)
'déclaration d'un objet Node
Dim NodeX As Node
Dim strArray() As String
strArray = Split(p_strDestination, "")
'Préparation du view tree
TreeViewCtl.Nodes.Clear
Set NodeX = TreeViewCtl.Nodes.Add(, , p_strDestination, strArray(UBound(strArray)), 1, 2)
TreeViewCtl.Nodes.Item(p_strDestination).Selected = True
Set NodeX = TreeViewCtl.SelectedItem
'sablier
Me.MousePointer = 11
FindFilesAPI p_strDestination, NodeX
NodeX.Expanded = True
'pointeur de la souris
Me.MousePointer = 0
NodeX.Selected = True
End Sub
Sub FindFilesAPI(ByVal sPath As String, ByRef pNode As Node)
On Error GoTo Erreurs
Dim DirName As String ' Nom du sous-dossiers
Dim hSearch As Long ' Handle de recherche
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
Dim nNombreDir As Integer
Dim tempNode As Node
Dim tempNode2 As Node
Dim lngNombreDeSousFichier As Long
Dim objFSO As Scripting.FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Met le bon format du chemin
If Right(sPath, 1) <> "" Then
sPath = sPath & ""
End If
' Recherche les sous-dossiers
Cont = True
hSearch = FindFirstFile(sPath & "*", WFD)
If TreeViewCtl.SelectedItem.children < 1 Then
If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont
Set tempNode2 = TreeViewCtl.SelectedItem
DirName = StripNulls(WFD.cFileName)
If objFSO.FolderExists(sPath & DirName & "") And (DirName <> ".") And (DirName <> "..") Then
If objFSO.GetFolder(sPath & DirName & "").Attributes <> 22 Then
lngNombreDeSousFichier = objFSO.GetFolder(sPath & DirName & "").Files.Count
If lngNombreDeSousFichier <> 0 Then
Set tempNode = TreeViewCtl.Nodes.Add(, , sPath & DirName & "", DirName & " ( nombres de fichiers : " & lngNombreDeSousFichier & ")", 1, 2)
Else
Set tempNode = TreeViewCtl.Nodes.Add(, , sPath & DirName & "", DirName, 1, 2)
End If
'objFSO.Drives.Count
nNombreDir = objFSO.GetFolder(sPath & DirName & "").SubFolders.Count
If nNombreDir <> 0 Then
Set tempNode2 = TreeViewCtl.Nodes.Add(, , DirName & nNombreDir, , 1, 2)
Set tempNode2.Parent = tempNode
End If
Set tempNode.Parent = pNode
End If
'End If
End If
Cont = FindNextFile(hSearch, WFD) 'Obtient le sous-dossier suivant.
Loop
Cont = FindClose(hSearch)
pNode.Sorted = True
End If
End If
Exit Sub
Erreurs:
MsgBox "Voici le chemin spécifié : " & sPath
End Sub
Private Sub BuildFileTree(p_strDestination As String)
On Error GoTo Erreurs
'déclaration d'un objet Node
Dim NodeX As Node
Dim NodeParent As Node
Dim strArray() As String
Dim hSearch As Long
Dim Cont As Long
Dim FileName As String
Dim strExtension As String
Dim WFD As WIN32_FIND_DATA
Dim lngIcone As Long
Dim objFSO As Scripting.FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
Me.MousePointer = 11
'Met le bon format du chemin
If Right(p_strDestination, 1) <> "" Then p_strDestination = p_strDestination & ""
strArray = Split(p_strDestination, "")
'Préparation du view tree
TreeViewFile.Nodes.Clear
hSearch = FindFirstFile(p_strDestination & "*", WFD)
Set NodeParent = TreeViewFile.Nodes.Add(, , "root", strArray(UBound(strArray) - 1), 21, 15)
NodeParent.Expanded = True
NodeParent.Selected = True
Cont = 1
If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont
FileName = StripNulls(WFD.cFileName)
If objFSO.FileExists(p_strDestination & FileName) Then
strExtension = LCase(objFSO.GetExtensionName(p_strDestination & FileName))
If DicIcones.Exists(strExtension) Then
lngIcone = (DicIcones.Item(strExtension))
Else
lngIcone = 9
End If
Set NodeX = TreeViewFile.Nodes.Add(, , p_strDestination & FileName, FileName, lngIcone, lngIcone)
Set NodeX.Parent = NodeParent
End If
Cont = FindNextFile(hSearch, WFD) 'Obtient le sous-dossier suivant.
Loop
End If
Cont = FindClose(hSearch)
Me.MousePointer = 0
TreeViewFile.SelectedItem.Sorted = True
Exit Sub
Erreurs:
MsgBox "Voici le chemin spécifié : " & p_strDestination
End Sub
Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = Left$(OriginalStr, 1) & (Mid$(OriginalStr, 2))
If Err.Number = 35602 Then Exit Function
End Function
Private Sub Label1_Click()
CNouveau_Click
Text1.Text = TreeViewFile.SelectedItem
Set DocE = GetObject(TreeViewFile.SelectedItem.Key)
'DocE.sheets("Description").Select
Text2.Text = (DocE.worksheets(1).range("AK8"))
Text5.Text = (DocE.worksheets(1).range("AO12"))
Text3.Text = (DocE.worksheets(1).range("C8"))
Text4.Text = (DocE.worksheets(1).range("Y8"))
Text6.Text = (DocE.worksheets(1).range("E16"))
Text8.Text = (DocE.worksheets(1).range("E19"))
Text10.Text = (DocE.worksheets(1).range("E22"))
Text12.Text = (DocE.worksheets(1).range("E25"))
Text14.Text = (DocE.worksheets(1).range("E28"))
Text16.Text = (DocE.worksheets(1).range("E31"))
Text18.Text = (DocE.worksheets(1).range("E34"))
Text20.Text = (DocE.worksheets(1).range("E37"))
Text22.Text = (DocE.worksheets(1).range("E40"))
Text24.Text = (DocE.worksheets(1).range("E43"))
Text28.Text = (DocE.worksheets(1).range("E46"))
Text30.Text = (DocE.worksheets(1).range("E49"))
If Text6.Text = "" Then
Text6.Text = rs.Fields("Description_1").DefaultValue
End If
If Text8.Text = "" Then
Text8.Text = rs.Fields("Description_2").Value
End If
If Text10.Text = "" Then
Text10.Text = rs.Fields("Description_3").DefaultValue
End If
If Text12.Text = "" Then
Text12.Text = rs.Fields("Description_4").DefaultValue
End If
If Text14.Text = "" Then
Text14.Text = rs.Fields("Description_5").DefaultValue
End If
If Text16.Text = "" Then
Text16.Text = rs.Fields("Description_6").DefaultValue
End If
If Text18.Text = "" Then
Text18.Text = rs.Fields("Description_7").DefaultValue
End If
If Text20.Text = "" Then
Text20.Text = rs.Fields("Description_8").DefaultValue
End If
If Text22.Text = "" Then
Text22.Text = rs.Fields("Description_9").DefaultValue
End If
If Text24.Text = "" Then
Text24.Text = rs.Fields("Description_10").DefaultValue
End If
If Text28.Text = "" Then
Text28.Text = rs.Fields("Description_10").DefaultValue
End If
If Text30.Text = "" Then
Text30.Text = rs.Fields("Description_10").DefaultValue
End If
Text7.Text = (DocE.worksheets(1).range("AI16"))
Text9.Text = (DocE.worksheets(1).range("AI19"))
Text11.Text = (DocE.worksheets(1).range("AI22"))
Text13.Text = (DocE.worksheets(1).range("AI25"))
Text15.Text = (DocE.worksheets(1).range("AI28"))
Text17.Text = (DocE.worksheets(1).range("AI31"))
Text19.Text = (DocE.worksheets(1).range("AI34"))
Text21.Text = (DocE.worksheets(1).range("AI37"))
Text23.Text = (DocE.worksheets(1).range("AI40"))
Text25.Text = (DocE.worksheets(1).range("AI43"))
Text29.Text = (DocE.worksheets(1).range("AI46"))
Text31.Text = (DocE.worksheets(1).range("AI49"))
If Text7.Text = "" Then
Text7.Text = rs.Fields("Defaut_1").Value
End If
If Text9.Text = "" Then
Text9.Text = rs.Fields("Defaut_2").Value
End If
If Text11.Text = "" Then
Text11.Text = rs.Fields("Defaut_3").DefaultValue
End If
If Text13.Text = "" Then
Text13.Text = rs.Fields("Defaut_4").DefaultValue
End If
If Text15.Text = "" Then
Text15.Text = rs.Fields("Defaut_5").DefaultValue
End If
If Text17.Text = "" Then
Text17.Text = rs.Fields("Defaut_6").DefaultValue
End If
If Text19.Text = "" Then
Text19.Text = rs.Fields("Defaut_7").DefaultValue
End If
If Text21.Text = "" Then
Text21.Text = rs.Fields("Defaut_8").DefaultValue
End If
If Text23.Text = "" Then
Text23.Text = rs.Fields("Defaut_9").DefaultValue
End If
If Text25.Text = "" Then
Text25.Text = rs.Fields("Defaut_10").DefaultValue
End If
If Text28.Text = "" Then
Text28.Text = rs.Fields("Defaut_10").DefaultValue
End If
If Text29.Text = "" Then
Text29.Text = rs.Fields("Defaut_10").DefaultValue
End If
If Text30.Text = "" Then
Text30.Text = rs.Fields("Defaut_10").DefaultValue
End If
If Text31.Text = "" Then
Text31.Text = rs.Fields("Defaut_10").DefaultValue
End If
End Sub
Private Sub MAJ_Click()
rs.OpenRecordset
End Sub
Private Sub OuvDB_Click()
Set db = OpenDatabase(App.Path & "\RMC.mdb") 'Ouvre la base de données
Set rs = db.OpenRecordset("select * from RMC", dbOpenDynaset)
rs.MoveLast
'Affiche le premier enregistrement
Text1.Text = rs!RMC
Text2.Text = rs!Container
Text3.Text = rs!Demandeur
Text4.Text = rs!Date
Text5.Text = rs!Quantité
Text6.Text = rs!Description_1
Text7.Text = rs!Defaut_1
Text8.Text = rs!Description_2
Text9.Text = rs!Defaut_2
Text10.Text = rs!Description_3
Text11.Text = rs!Defaut_3
Text12.Text = rs!Description_4
Text13.Text = rs!Defaut_4
Text14.Text = rs!Description_5
Text15.Text = rs!Defaut_5
Text16.Text = rs!Description_6
Text17.Text = rs!Defaut_6
Text18.Text = rs!Description_7
Text19.Text = rs!Defaut_7
Text20.Text = rs!Description_8
Text21.Text = rs!Defaut_8
Text22.Text = rs!Description_9
Text23.Text = rs!Defaut_9
Text24.Text = rs!Description_10
Text25.Text = rs!Defaut_10
Text26.Text = rs!N°
Text28.Text = rs!Description_11
Text29.Text = rs!Defaut_11
Text30.Text = rs!Description_12
Text31.Text = rs!Defaut_12
OLE1.SetFocus
End Sub
Private Sub TreeViewCtl_NodeClick(ByVal pNode As ComctlLib.Node)
'sablier
Me.MousePointer = 11
If pNode.children > 0 Then
pNode.Expanded = True
Else
FindFilesAPI pNode.Key, pNode
End If
BuildFileTree (pNode.Key)
'pointeur de la souris
Me.MousePointer = 0
End Sub
Private Sub TreeViewCtl_Collapse(ByVal Node As ComctlLib.Node)
Node.Expanded = False
End Sub
Private Sub TreeViewCtl_Expand(ByVal pNode As ComctlLib.Node)
If pNode.Child = vbNullString Then
TreeViewCtl.Nodes.Remove (pNode.Child.Index)
End If
'sablier
Me.MousePointer = 11
pNode.Selected = True
FindFilesAPI pNode.Key, pNode
'pointeur de la souris
Me.MousePointer = 0
End Sub
Private Sub TreeViewFile_Click()
Dim NodeX As Node
Set NodeX = TreeViewFile.SelectedItem
If Not (TreeViewFile.SelectedItem.Key = "root") Then
OLE1.CreateLink (TreeViewFile.SelectedItem.Key)
Else
If NodeX.Expanded = False Then
NodeX.Expanded = False
NodeX.Selected = False
Else
NodeX.Expanded = True
NodeX.Selected = True
End If
End If
End Sub