par Michael DELIQUE » 21 Mars 2011 à 14:06
- Code : Tout sélectionner
Function ColorHexaToLong(wColorHexa As String) As Long
On Error GoTo CatchError
ColorHexaToLong = 0
If Trim(wColorHexa)= "" Then
Error 9999,"wColorHexa is Empty"
Exit Function
End If
Select Case Len(Trim(wColorHexa))
Case 7
ColorHexaToLong = Val("&H" + Right(Trim(wColorHexa),6) + "&")
Case 6
ColorHexaToLong = Val("&H" + Trim(wColorHexa) + "&")
Case Else
Error 9999,"wColorHexa not valid : "+Trim(wColorHexa)
End Select
Exit Function
CatchError:
MsgBox "("+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
ColorHexaToLong = 0
Exit Function
End Function
- Code : Tout sélectionner
Function ColorHexaToRGB(wColorHexa As String)As Variant
Dim ColorHexa As String
Dim lstColor List As Byte
On Error GoTo CatchError
If Trim(wColorHexa)= "" Then
Error 9999,"wColorHexa is Empty"
Exit Function
End If
Select Case Len(Trim(wColorHexa))
Case 7
ColorHexa = Right(Trim(wColorHexa),6)
Case 6
ColorHexa = "#"+Trim(wColorHexa)
Case Else
Error 9999,"wColorHexa not valid : "+Trim(wColorHexa)
End Select
lstColor("R")=CByte("&H" + Mid(ColorHexa, 2, 2))
lstColor("G")=CByte("&H" + Mid(ColorHexa, 4, 2))
lstColor("B")=CByte("&H" + Mid(ColorHexa, 6, 2))
ColorHexaToRGB = lstColor
Erase lstColor
Exit Function
CatchError:
MsgBox "("+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
Erase lstColor
lstColor("R")=0
lstColor("G")=0
lstColor("B")=0
ColorHexaToRGB = lstColor
Erase lstColor
Exit Function
End Function
- Code : Tout sélectionner
Function ColorHexaToXLS(wColorHexa As String,wType As String) As Byte
On Error GoTo CatchError
ColorHexaToXLS = 0
Select Case LCase(Trim(wType))
Case "chart fills","fills","fill","f"
Select Case Trim(wColorHexa)
Case "#9999FF","9999FF","16"
ColorHexaToXLS = 16
Case "#993366","993366","17"
ColorHexaToXLS = 17
Case "#FFFFCC","FFFFCC","18"
ColorHexaToXLS = 18
Case "#CCFFFF","CCFFFF","19"
ColorHexaToXLS = 19
Case "#660066","660066","20"
ColorHexaToXLS = 20
Case "#FF8080","FF8080","21"
ColorHexaToXLS = 21
Case "#0066CC","0066CC","22"
ColorHexaToXLS = 22
Case "#CCCCFF","CCCCFF","23"
ColorHexaToXLS = 23
Case Else
Error 9999,"Bad Excel code for Chart Fills : "+Trim(wColorHexa)
End Select
Case "chart lines","lines","line","l"
Select Case Trim(wColorHexa)
Case "#000080","000080","24"
ColorHexaToXLS = 24
Case "#FF00FF","FF00FF","25"
ColorHexaToXLS = 25
Case "#FFFF00","FFFF00","26"
ColorHexaToXLS = 26
Case "#00FFFF","00FFFF","27"
ColorHexaToXLS = 27
Case "#800080","800080","28"
ColorHexaToXLS = 28
Case "#800000","800000","800","800","29"
ColorHexaToXLS = 29
Case "#008080","008080","30"
ColorHexaToXLS = 30
Case "#0000FF","0000FF","31"
ColorHexaToXLS = 31
Case Else
Error 9999,"Bad Excel code for Chart Lines : "+Trim(wColorHexa)
End Select
Case Else
Select Case Trim(wColorHexa)
Case "#000000","000000","#000","000","0"
ColorHexaToXLS = 0
Case "#FFFFFF","FFFFFF","1"
ColorHexaToXLS = "1"
Case "#FF0000","FF0000","#FF0","FF0","2"
ColorHexaToXLS = 2
Case "#00FF00","00FF00","3"
ColorHexaToXLS = 3
Case "#0000FF","0000FF","4"
ColorHexaToXLS = 4
Case "#FFFF00","FFFF00","5"
ColorHexaToXLS = 5
Case "#FF00FF","FF00FF","6"
ColorHexaToXLS = 6
Case "#00FFFF","00FFFF","7"
ColorHexaToXLS = 7
Case "#800000","800000","#800","800","8"
ColorHexaToXLS = 8
Case "#008000","008000","#008","008","9"
ColorHexaToXLS = 9
Case "#000080","000080","10"
ColorHexaToXLS = 10
Case "#808000","808000","#808","808","11"
ColorHexaToXLS = 11
Case "#800080","800080","12"
ColorHexaToXLS = 12
Case "#008080","008080","13"
ColorHexaToXLS = 13
Case "#C0C0C0","C0C0C0","14"
ColorHexaToXLS = 14
Case "#808080","808080","15"
ColorHexaToXLS = 15
Case "#00CCFF","00CCFF","32"
ColorHexaToXLS = 32
Case "#CCFFFF","CCFFFF","33"
ColorHexaToXLS = 33
Case "#CCFFCC","CCFFCC","34"
ColorHexaToXLS = 34
Case "#FFFF99","FFFF99","35"
ColorHexaToXLS = 35
Case "#99CCFF","99CCFF","36"
ColorHexaToXLS = 36
Case "#FF99CC","FF99CC","37"
ColorHexaToXLS = 37
Case "#CC99FF","CC99FF","38"
ColorHexaToXLS = 38
Case "#FFCC99","FFCC99","39"
ColorHexaToXLS = 39
Case "#3366FF","3366FF","40"
ColorHexaToXLS = 40
Case "#33CCCC","33CCCC","41"
ColorHexaToXLS = 41
Case "#99CC00","99CC00","42"
ColorHexaToXLS = 42
Case "#FFCC00","FFCC00","43"
ColorHexaToXLS = 43
Case "#FF9900","FF9900","44"
ColorHexaToXLS = 44
Case "#FF6600","FF6600","45"
ColorHexaToXLS = 45
Case "#666699","666699","46"
ColorHexaToXLS = 46
Case "#969696","969696","47"
ColorHexaToXLS = 47
Case "#003300","003300","48"
ColorHexaToXLS = 48
Case "#339966","339966","49"
ColorHexaToXLS = 49
Case "#003300","#003300","50"
ColorHexaToXLS = 50
Case "#333300","333300","51"
ColorHexaToXLS = 51
Case "#993300","993300","52"
ColorHexaToXLS = 52
Case "#993366","#993366","53"
ColorHexaToXLS = 53
Case "#333399","333399","54"
ColorHexaToXLS = 54
Case "#333333","333333","55"
ColorHexaToXLS = 55
Case Else
Error 9999,"Hexa color code not convertible : "+Trim(wColorHexa)
End Select
End Select
Exit Function
CatchError:
MsgBox "("+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
ColorHexaToXLS = 0
Exit Function
End Function
- Code : Tout sélectionner
Function ColorLongToHexa(wnbColor As Long) As String
Dim Temp As String
On Error GoTo CatchError
Temp = CStr(Hex(CByte(Abs(wnbColor) Mod 256)))
If Len(Temp) < 2 Then
ColorLongToHexa = "0" + Temp
Else
ColorLongToHexa = Temp
End If
Temp = CStr(Hex(CByte((Abs(wnbColor) Mod 65536) / 256)))
If Len(Temp) < 2 Then
ColorLongToHexa = ColorLongToHexa+"0" + Temp
Else
ColorLongToHexa = ColorLongToHexa+Temp
End If
Temp = CStr(Hex(CByte(CByte(Abs(wnbColor) / 65536))))
If Len(Temp) < 2 Then
ColorLongToHexa = "#"+ColorLongToHexa +"0" + Temp
Else
ColorLongToHexa = "#"+ColorLongToHexa+Temp
End If
Exit Function
CatchError:
MsgBox "("+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
Exit Function
End Function
- Code : Tout sélectionner
Function ColorLongToRGB(wnbColor As Long) As Variant
Dim lstColor List As Byte
On Error GoTo CatchError
lstColor("R")=CByte(Abs(wnbColor) Mod 256)
lstColor("G")=CByte((Abs(wnbColor) Mod 65536) / 256)
lstColor("B")=CByte(Abs(wnbColor) / 65536)
ColorLongToRGB = lstColor
Erase lstColor
Exit Function
CatchError:
MsgBox "("+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
Erase lstColor
lstColor("R")=0
lstColor("G")=0
lstColor("B")=0
ColorLongToRGB = lstColor
Erase lstColor
Exit Function
End Function
- Code : Tout sélectionner
Function ColorRGBToHexa(wnbRed As Byte,wnbGreen As Byte,wnbBlue As Byte) As String
Dim temp As String
On Error GoTo CatchError
Temp = CStr(Hex(wnbRed))
If Len(Temp) < 2 Then
ColorRGBToHexa = "0" + Temp
Else
ColorRGBToHexa = Temp
End If
Temp = CStr(Hex(wnbGreen))
If Len(Temp) < 2 Then
ColorRGBToHexa = ColorRGBToHexa+"0" + Temp
Else
ColorRGBToHexa = ColorRGBToHexa+Temp
End If
Temp = CStr(Hex(wnbBlue))
If Len(Temp) < 2 Then
ColorRGBToHexa = "#"+ColorRGBToHexa +"0" + Temp
Else
ColorRGBToHexa = "#"+ColorRGBToHexa+Temp
End If
Exit Function
CatchError:
MsgBox "("+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
ColorRGBToHexa = ""
Exit Function
End Function
- Code : Tout sélectionner
Function ColorRGBToLong (wnbRed As Byte,wnbGreen As Byte,wnbBlue As Byte) As Long
On Error GoTo CatchError
ColorRGBToLong =(CLng(wnbBlue )*65536)+(CLng(wnbGreen)*256)+CLng(wnbRed)
Exit Function
CatchError:
MsgBox "("+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
Exit Function
End Function
- Code : Tout sélectionner
Function ColorRGBToXLS(wnbRed As Byte,wnbGreen As Byte,wnbBlue As Byte,wType As String) As Byte
Dim RGB As String
On Error GoTo CatchError
ColorRGBToXLS = 0
RGB = Trim(CStr(wnbRed)+"."+CStr(wnbGreen)+"."+cstr(wnbBlue))
Select Case LCase(Trim(wType))
Case "chart fills","fills","fill","f"
Select Case RGB
Case "153.153.255"
ColorRGBToXLS = 16
Case "153.51.102"
ColorRGBToXLS = 17
Case "255.255.204"
ColorRGBToXLS = 18
Case "204.255.255"
ColorRGBToXLS = 19
Case "102.0.102"
ColorRGBToXLS = 20
Case "255.128.128"
ColorRGBToXLS = 21
Case "0.102.204"
ColorRGBToXLS = 22
Case "204.204.255"
ColorRGBToXLS = 23
Case Else
Error 9999,"Bad Excel code for Chart Fills : "+RGB
End Select
Case "chart lines","lines","line","l"
Select Case RGB
Case "0.0.128"
ColorRGBToXLS = 24
Case "255.0.255"
ColorRGBToXLS = 25
Case "255.255.0"
ColorRGBToXLS = 26
Case "0.255.255"
ColorRGBToXLS = 27
Case "128.0.128"
ColorRGBToXLS = 28
Case "128.0.0"
ColorRGBToXLS = 29
Case "0.128.128"
ColorRGBToXLS = 30
Case "0.0.255"
ColorRGBToXLS = 31
Case Else
Error 9999,"Bad Excel code for Chart Fills : "+RGB
End Select
Case Else
Select Case RGB
Case "0.0.0"
ColorRGBToXLS = 0
Case "255.255.255"
ColorRGBToXLS = "1"
Case "255.0.0"
ColorRGBToXLS = 2
Case "0.255.0"
ColorRGBToXLS = 3
Case "0.0.255"
ColorRGBToXLS = 4
Case "255.255.0"
ColorRGBToXLS = 5
Case "255.0.255"
ColorRGBToXLS = 6
Case "0.255.255"
ColorRGBToXLS = 7
Case "128.0.0"
ColorRGBToXLS = 8
Case "0.128.0"
ColorRGBToXLS = 9
Case "0.0.128"
ColorRGBToXLS = 10
Case "128.128.0"
ColorRGBToXLS = 11
Case "128.0.128"
ColorRGBToXLS = 12
Case "0.128.128"
ColorRGBToXLS = 13
Case "192.192.192"
ColorRGBToXLS = 14
Case "128.128.128"
ColorRGBToXLS = 15
Case "0.204.255"
ColorRGBToXLS = 32
Case "204.255.255"
ColorRGBToXLS = 33
Case "204.255.204"
ColorRGBToXLS = 34
Case "255.255.153"
ColorRGBToXLS = 35
Case "153.204.255"
ColorRGBToXLS = 36
Case "255.153.204"
ColorRGBToXLS = 37
Case "204.153.255"
ColorRGBToXLS = 38
Case "255.204.153"
ColorRGBToXLS = 39
Case "51.102.255"
ColorRGBToXLS = 40
Case "51.204.204"
ColorRGBToXLS = 41
Case "153.204.0"
ColorRGBToXLS = 42
Case "255.204.0"
ColorRGBToXLS = 43
Case "255.153.0"
ColorRGBToXLS = 44
Case "255.102.0"
ColorRGBToXLS = 45
Case "102.102.153"
ColorRGBToXLS = 46
Case "150.150.150"
ColorRGBToXLS = 47
Case "0.51.102"
ColorRGBToXLS = 48
Case "51.153.102"
ColorRGBToXLS = 49
Case "0.51.0"
ColorRGBToXLS = 50
Case "51.51.0"
ColorRGBToXLS = 51
Case "153.51.0"
ColorRGBToXLS = 52
Case "153.51.102"
ColorRGBToXLS = 53
Case "51.51.153"
ColorRGBToXLS = 54
Case "51.51.51"
ColorRGBToXLS = 55
Case Else
Error 9999,"Bad Excel code for Chart Fills : "+RGB
End Select
End Select
Exit Function
CatchError:
MsgBox "("+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
ColorRGBToXLS = 0
Exit Function
End Function
- Code : Tout sélectionner
Function ColorXLSToHexa(wnbColor As Byte) As String
On Error GoTo CatchError
ColorXLSToHexa = ""
Select Case wnbColor
Case 0
ColorXLSToHexa = "#000000"
Case 1
ColorXLSToHexa = "#FFFFFF"
Case 2
ColorXLSToHexa = "#FF0000"
Case 3
ColorXLSToHexa = "#00FF00"
Case 4
ColorXLSToHexa = "#0000FF"
Case 5
ColorXLSToHexa = "#FFFF00"
Case 6
ColorXLSToHexa = "#FF00FF"
Case 7
ColorXLSToHexa = "#00FFFF"
Case 8
ColorXLSToHexa = "#800000"
Case 9
ColorXLSToHexa = "#008000"
Case 10
ColorXLSToHexa = "#000080"
Case 11
ColorXLSToHexa = "#808000"
Case 12
ColorXLSToHexa = "#800080"
Case 13
ColorXLSToHexa = "#008080"
Case 14
ColorXLSToHexa = "#C0C0C0"
Case 15
ColorXLSToHexa = "#808080"
Case 16
ColorXLSToHexa = "#9999FF"
Case 17
ColorXLSToHexa = "#993366"
Case 18
ColorXLSToHexa = "#FFFFCC"
Case 19
ColorXLSToHexa = "#CCFFFF"
Case 20
ColorXLSToHexa = "#660066"
Case 21
ColorXLSToHexa = "#FF8080"
Case 22
ColorXLSToHexa = "#0066CC"
Case 23
ColorXLSToHexa = "#CCCCFF"
Case 24
ColorXLSToHexa = "#000080"
Case 25
ColorXLSToHexa = "#FF00FF"
Case 26
ColorXLSToHexa = "#FFFF00"
Case 27
ColorXLSToHexa = "#00FFFF"
Case 28
ColorXLSToHexa = "#800080"
Case 29
ColorXLSToHexa = "#800000"
Case 30
ColorXLSToHexa = "#008080"
Case 31
ColorXLSToHexa = "#0000FF"
Case 32
ColorXLSToHexa = "#00CCFF"
Case 33
ColorXLSToHexa = "#CCFFFF"
Case 34
ColorXLSToHexa = "#CCFFCC"
Case 35
ColorXLSToHexa = "#FFFF99"
Case 36
ColorXLSToHexa = "#99CCFF"
Case 37
ColorXLSToHexa = "#FF99CC"
Case 38
ColorXLSToHexa = "#CC99FF"
Case 39
ColorXLSToHexa = "#FFCC99"
Case 40
ColorXLSToHexa = "#3366FF"
Case 41
ColorXLSToHexa = "#33CCCC"
Case 42
ColorXLSToHexa = "#99CC00"
Case 43
ColorXLSToHexa = "#FFCC00"
Case 44
ColorXLSToHexa = "#FF9900"
Case 45
ColorXLSToHexa = "#FF6600"
Case 46
ColorXLSToHexa = "#666699"
Case 47
ColorXLSToHexa = "#969696"
Case 48
ColorXLSToHexa = "#003300"
Case 49
ColorXLSToHexa = "#339966"
Case 50
ColorXLSToHexa = "#003300"
Case 51
ColorXLSToHexa = "#333300"
Case 52
ColorXLSToHexa = "#993300"
Case 53
ColorXLSToHexa = "#993366"
Case 54
ColorXLSToHexa = "#333399"
Case 55
ColorXLSToHexa = "#333333"
Case Else
Error 9999,"Excel color code unknown : "+CStr(wnbColor)
End Select
Exit Function
CatchError:
MsgBox "("+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
ColorXLSToHexa = ""
Exit Function
End Function
- Code : Tout sélectionner
Function ColorXLSToRGB(wnbColor As Byte)
Dim lstColor List As Byte
On Error GoTo CatchError
lstColor("R") = 0
lstColor("G") = 0
lstColor("B") = 0
Select Case wnbColor
Case 0
lstColor("R") = 0
lstColor("G") = 0
lstColor("B") = 0
Case 1
lstColor("R") = 255
lstColor("G") = 255
lstColor("B") = 255
Case 2
lstColor("R") = 255
lstColor("G") = 0
lstColor("B") = 0
Case 3
lstColor("R") = 0
lstColor("G") = 255
lstColor("B") = 0
Case 4
lstColor("R") = 0
lstColor("G") = 0
lstColor("B") = 255
Case 5
lstColor("R") = 255
lstColor("G") = 255
lstColor("B") = 0
Case 6
lstColor("R") = 255
lstColor("G") = 0
lstColor("B") = 255
Case 7
lstColor("R") = 0
lstColor("G") = 255
lstColor("B") = 255
Case 8
lstColor("R") = 128
lstColor("G") = 0
lstColor("B") = 0
Case 9
lstColor("R") = 0
lstColor("G") = 128
lstColor("B") = 0
Case 10
lstColor("R") = 0
lstColor("G") = 0
lstColor("B") = 128
Case 11
lstColor("R") = 0
lstColor("G") = 128
lstColor("B") = 128
Case 12
lstColor("R") = 128
lstColor("G") = 0
lstColor("B") = 128
Case 13
lstColor("R") = 0
lstColor("G") = 128
lstColor("B") = 128
Case 14
lstColor("R") = 192
lstColor("G") = 192
lstColor("B") = 192
Case 15
lstColor("R") = 128
lstColor("G") = 128
lstColor("B") = 128
Case 16
lstColor("R") = 153
lstColor("G") = 153
lstColor("B") = 255
Case 17
lstColor("R") = 153
lstColor("G") = 51
lstColor("B") = 102
Case 18
lstColor("R") = 255
lstColor("G") = 255
lstColor("B") = 204
Case 19
lstColor("R") = 204
lstColor("G") = 255
lstColor("B") = 255
Case 20
lstColor("R") = 102
lstColor("G") = 0
lstColor("B") = 102
Case 21
lstColor("R") = 255
lstColor("G") = 128
lstColor("B") = 128
Case 22
lstColor("R") = 0
lstColor("G") = 102
lstColor("B") = 204
Case 23
lstColor("R") = 204
lstColor("G") = 204
lstColor("B") = 255
Case 24
lstColor("R") = 0
lstColor("G") = 0
lstColor("B") = 128
Case 25
lstColor("R") = 255
lstColor("G") = 0
lstColor("B") = 255
Case 26
lstColor("R") = 255
lstColor("G") = 255
lstColor("B") = 0
Case 27
lstColor("R") = 0
lstColor("G") = 255
lstColor("B") = 255
Case 28
lstColor("R") = 128
lstColor("G") = 0
lstColor("B") = 128
Case 29
lstColor("R") = 128
lstColor("G") = 0
lstColor("B") = 0
Case 30
lstColor("R") = 0
lstColor("G") = 128
lstColor("B") = 128
Case 31
lstColor("R") = 0
lstColor("G") = 0
lstColor("B") = 255
Case 32
lstColor("R") = 0
lstColor("G") = 204
lstColor("B") = 255
Case 33
lstColor("R") = 204
lstColor("G") = 255
lstColor("B") = 255
Case 34
lstColor("R") = 0
lstColor("G") = 0
lstColor("B") = 0
Case 35
lstColor("R") = 255
lstColor("G") = 255
lstColor("B") = 153
Case 36
lstColor("R") = 153
lstColor("G") = 204
lstColor("B") = 255
Case 37
lstColor("R") = 255
lstColor("G") = 153
lstColor("B") = 204
Case 38
lstColor("R") = 204
lstColor("G") = 153
lstColor("B") = 255
Case 39
lstColor("R") = 255
lstColor("G") = 204
lstColor("B") = 153
Case 40
lstColor("R") = 51
lstColor("G") = 102
lstColor("B") = 255
Case 41
lstColor("R") = 51
lstColor("G") = 204
lstColor("B") = 204
Case 42
lstColor("R") = 153
lstColor("G") = 204
lstColor("B") = 0
Case 43
lstColor("R") = 255
lstColor("G") = 204
lstColor("B") = 0
Case 44
lstColor("R") = 255
lstColor("G") = 153
lstColor("B") = 0
Case 45
lstColor("R") = 255
lstColor("G") = 102
lstColor("B") = 0
Case 46
lstColor("R") = 102
lstColor("G") = 102
lstColor("B") = 153
Case 47
lstColor("R") = 150
lstColor("G") = 150
lstColor("B") = 150
Case 48
lstColor("R") = 0
lstColor("G") = 51
lstColor("B") = 102
Case 49
lstColor("R") = 51
lstColor("G") = 153
lstColor("B") = 102
Case 50
lstColor("R") = 0
lstColor("G") = 51
lstColor("B") = 0
Case 51
lstColor("R") = 51
lstColor("G") = 51
lstColor("B") = 0
Case 52
lstColor("R") = 153
lstColor("G") = 51
lstColor("B") = 0
Case 53
lstColor("R") = 153
lstColor("G") = 51
lstColor("B") = 102
Case 54
lstColor("R") = 51
lstColor("G") = 51
lstColor("B") = 153
Case 55
lstColor("R") = 51
lstColor("G") = 51
lstColor("B") = 51
Case Else
Error 9999,"Excel color code unknown : "+CStr(wnbColor)
End Select
ColorXLSToRGB = lstColor
Erase lstColor
Exit Function
CatchError:
MsgBox "("+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
Erase lstColor
lstColor("R") = 0
lstColor("G") = 0
lstColor("B") = 0
ColorXLSToRGB = lstColor
Erase lstColor
Exit Function
End Function
Cordialement
Michael (SMS-Phobique)
----------------------------
"La théorie, c'est quand on sait tout et que rien ne fonctionne. La pratique, c'est quand tout fonctionne et que personne ne sait pourquoi."
Albert EINSTEIN
