DominoArea.org [Archive]

Publié: **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

DominoArea.org [Archive]

Conversion de Couleur en LS

Conversion de Couleur en LS