Option Explicit
Function Vide(ByVal R As Range) As Variant()
Vide = Array(IsEmpty(R.Value), R.Value = "", R.HasFormula, DescrValRg(R))
End Function
Private Function DescrValRg(ByVal V) As String
Dim N°Err As Integer
DescrValRg = TypeName(V): If DescrValRg = "Range" Then V = V.Value: DescrValRg = TypeName(V)
Select Case VarType(V)
Case Is >= vbArray: DescrValRg = Replace(DescrValRg, ")", "1 to " & UBound(V, 1) & ", 1 to " & UBound(V, 2) & ")")
Case vbDouble: DescrValRg = DescrValRg & " =" & V
Case vbCurrency: DescrValRg = DescrValRg & " =" & Format(V, "0.0000")
Case vbDate: DescrValRg = DescrValRg & " =" & Format(V, "dd/mm/yyyy hh:mm:ss")
Case vbString: DescrValRg = DescrValRg & " =""" & Replace(V, """", """""") & """"
Case vbBoolean: DescrValRg = DescrValRg & " =" & IIf(V, "True", "False")
Case vbError: N°Err = CInt(V): Select Case N°Err
Case xlErrNull: DescrValRg = DescrValRg & " =CvErr(xlErrNull)"
Case xlErrDiv0: DescrValRg = DescrValRg & " =CvErr(xlErrDiv0)"
Case xlErrValue: DescrValRg = DescrValRg & " =CvErr(xlErrValue)"
Case xlErrRef: DescrValRg = DescrValRg & " =CvErr(xlErrRef)"
Case xlErrName: DescrValRg = DescrValRg & " =CvErr(xlErrName)"
Case xlErrNum: DescrValRg = DescrValRg & " =CvErr(xlErrNum)"
Case xlErrNA: DescrValRg = DescrValRg & " =CvErr(xlErrNA)"
Case Else: DescrValRg = DescrValRg & " =CvErr(" & N°Err & ")"
End Select: End Select
End Function