Skip to content

Commit

Permalink
Fixed #282 :)
Browse files Browse the repository at this point in the history
yves-amevoin committed Aug 11, 2024
1 parent 1b78eb9 commit c92c415
Showing 3 changed files with 108 additions and 45 deletions.
Binary file modified src/bin/designer_aky.xlsb
Binary file not shown.
77 changes: 54 additions & 23 deletions src/classes/implements/HListVars.cls
Original file line number Diff line number Diff line change
@@ -659,7 +659,9 @@ Private Sub AddValidation()
Dim validationTypes As Long
Dim validationAlerts As Long
Dim excelForm As Variant
Dim excelOSForm As Variant
Dim excelForm2 As Variant
Dim excelOSForm2 As Variant
Dim cellRng As Range

varTypes = ValueOf("variable type")
@@ -670,8 +672,6 @@ Private Sub AddValidation()

If (varMin = vbNullString And varMax = vbNullString) Or (varTypes = "text") Then Exit Sub

On Error GoTo validationError

Set cellRng = VarRange()

With cellRng.validation
@@ -689,30 +689,65 @@ Private Sub AddValidation()
If (varMin <> vbNullString) And (varMax = vbNullString) Then

excelForm = ExcelFormula(varMin, validationTypes)
excelOSForm = ExcelFormula(varMin, validationTypes, useOS:=True)

If IsEmpty(excelForm) Then Exit Sub

On Error Resume Next
.Add Type:=validationTypes, AlertStyle:=validationAlerts, _
Operator:=xlGreaterEqual, Formula1:=excelOSForm

.Add Type:=validationTypes, AlertStyle:=validationAlerts, _
Operator:=xlGreaterEqual, Formula1:=excelForm
On Error GoTo 0

ElseIf (varMin = vbNullString) And (varMax <> vbNullString) Then

'Validation on Maximum
excelForm = ExcelFormula(varMax, validationTypes)
excelOSForm = ExcelFormula(varMin, validationTypes, useOS:=True)

If IsEmpty(excelForm) Then Exit Sub

On Error Resume Next

.Add Type:=validationTypes, AlertStyle:=validationAlerts, _
Operator:=xlLessEqual, Formula1:=excelOSForm

.Add Type:=validationTypes, AlertStyle:=validationAlerts, _
Operator:=xlLessEqual, Formula1:=excelForm

On Error GoTo 0

ElseIf (varMin <> vbNullString) And (varMax <> vbNullString) Then

'Validation on Both minimum and maximum
excelForm = ExcelFormula(varMin, validationTypes)
excelOSForm = ExcelFormula(varMin, validationTypes, useOS:=True)
excelForm2 = ExcelFormula(varMax, validationTypes)
excelOSForm2 = ExcelFormula(varMax, validationTypes, useOS:=True)

Debug.Print "ExcelForm: " & excelForm
Debug.Print "ExcelOSForm: " & excelOSForm

Debug.Print "ExcelForm2: " & excelForm2
Debug.Print "ExcelOSForm2: " & excelOSForm2


If IsEmpty(excelForm) Or IsEmpty(excelForm2) Then Exit Sub

On Error Resume Next

.Add Type:=validationTypes, AlertStyle:=validationAlerts, _
Operator:=xlBetween, _
Formula1:=excelOSForm, Formula2:=excelOSForm2

.Add Type:=validationTypes, AlertStyle:=validationAlerts, _
Operator:=xlBetween, _
Formula1:=excelForm, Formula2:=excelForm2

On Error GoTo 0

End If

.IgnoreBlank = True
@@ -726,17 +761,13 @@ Private Sub AddValidation()

End With
Exit Sub

validationError:
Debug.Print "Validation error on variable " & ActualVariable() & "----------"
Debug.Print Err.Description & " -- " & Err.Number
Debug.Print "Excel formula: " & excelForm
Debug.Print "Excel second formula: " & excelForm2

End Sub

'Excel formula uses the OS to convert to local formula
Private Function ExcelFormula(ByVal formVal As String, ByVal validationTypes As Long) As Variant
Private Function ExcelFormula(ByVal formVal As String, _
ByVal validationTypes As Long, _
Optional ByVal useOS As Boolean = False) As Variant

Dim lData As ILinelistSpecs
Dim dict As ILLdictionary
@@ -758,9 +789,11 @@ Private Function ExcelFormula(ByVal formVal As String, ByVal validationTypes As
If FailedFormula(excelForm) Then Exit Function

'Removed conversion to OS formula on french desktops
'excelForm = OSFormula(excelForm)

excelForm = "= " & excelForm
If useOS Then
excelForm = OSFormula(excelForm)
Else
excelForm = "= " & excelForm
End If

If Not varFormObject.HasLiterals Then

@@ -792,18 +825,16 @@ Private Function OSFormula(ByVal formVal As String) As String
Dim sh As Worksheet
Dim prevForm As String 'Previous formula

'Sometimes, validations are done using the formula Local and not the formula itself,
'so will test the two.

Set sh = Wksh()
prevForm = sh.Cells(1, 1).formula
sh.Cells(1, 1).formula = "=" & formVal
OSFormula = sh.Cells(1, 1).FormulaLocal
'restore previous formula in cell
sh.Cells(1, 1).formula = prevForm

If (Application.OperatingSystem Like "*Mac*") Then
OSFormula = formVal
Else
'On windows, validations are done using the formula Local and not the formula itself
Set sh = Wksh()
prevForm = sh.Cells(1, 1).formula
sh.Cells(1, 1).formula = "=" & formVal
OSFormula = sh.Cells(1, 1).FormulaLocal
'restore previous formula in cell
sh.Cells(1, 1).formula = prevForm
End If
End Function

'Write one variable information in the corresponding cell.
76 changes: 54 additions & 22 deletions src/classes/implements/VListVars.cls
Original file line number Diff line number Diff line change
@@ -518,16 +518,17 @@ End Sub
'Add validation for VList var
Private Sub AddValidation()


Dim varMin As String
Dim varMax As String
Dim varMessage As String
Dim varAlert As String
Dim varTypes As String 'Something weird but we can't name a variable varType, so the s is important
Dim varTypes As String 'Something weird but we can't name a variable varType, so the s is important
Dim validationTypes As Long
Dim validationAlerts As Long
Dim excelForm As Variant
Dim excelOSForm As Variant
Dim excelForm2 As Variant
Dim excelOSForm2 As Variant
Dim cellRng As Range

varTypes = ValueOf("variable type")
@@ -538,9 +539,8 @@ Private Sub AddValidation()

If (varMin = vbNullString And varMax = vbNullString) Or (varTypes = "text") Then Exit Sub

On Error GoTo validationError

Set cellRng = VarRange()

With cellRng.validation
.Delete

@@ -556,29 +556,65 @@ Private Sub AddValidation()
If (varMin <> vbNullString) And (varMax = vbNullString) Then

excelForm = ExcelFormula(varMin, validationTypes)
excelOSForm = ExcelFormula(varMin, validationTypes, useOS:=True)

If IsEmpty(excelForm) Then Exit Sub

On Error Resume Next
.Add Type:=validationTypes, AlertStyle:=validationAlerts, _
Operator:=xlGreaterEqual, Formula1:=excelOSForm

.Add Type:=validationTypes, AlertStyle:=validationAlerts, _
Operator:=xlGreaterEqual, Formula1:=excelForm
On Error GoTo 0

ElseIf (varMin = vbNullString) And (varMax <> vbNullString) Then

'Validation on Maximum
excelForm = ExcelFormula(varMax, validationTypes)
excelOSForm = ExcelFormula(varMin, validationTypes, useOS:=True)

If IsEmpty(excelForm) Then Exit Sub

On Error Resume Next

.Add Type:=validationTypes, AlertStyle:=validationAlerts, _
Operator:=xlLessEqual, Formula1:=excelForm
Operator:=xlLessEqual, Formula1:=excelOSForm

.Add Type:=validationTypes, AlertStyle:=validationAlerts, _
Operator:=xlLessEqual, Formula1:=excelForm

On Error GoTo 0

ElseIf (varMin <> vbNullString) And (varMax <> vbNullString) Then

'Validation on Both minimum and maximum
excelForm = ExcelFormula(varMin, validationTypes)
excelOSForm = ExcelFormula(varMin, validationTypes, useOS:=True)
excelForm2 = ExcelFormula(varMax, validationTypes)
excelOSForm2 = ExcelFormula(varMax, validationTypes, useOS:=True)

Debug.Print "ExcelForm: " & excelForm
Debug.Print "ExcelOSForm: " & excelOSForm

Debug.Print "ExcelForm2: " & excelForm2
Debug.Print "ExcelOSForm2: " & excelOSForm2


If IsEmpty(excelForm) Or IsEmpty(excelForm2) Then Exit Sub

.Add Type:=validationTypes, AlertStyle:=validationAlerts, Operator:=xlBetween, _
On Error Resume Next

.Add Type:=validationTypes, AlertStyle:=validationAlerts, _
Operator:=xlBetween, _
Formula1:=excelOSForm, Formula2:=excelOSForm2

.Add Type:=validationTypes, AlertStyle:=validationAlerts, _
Operator:=xlBetween, _
Formula1:=excelForm, Formula2:=excelForm2

On Error GoTo 0

End If

.IgnoreBlank = True
@@ -593,16 +629,12 @@ Private Sub AddValidation()
End With
Exit Sub

validationError:
Debug.Print "Validation error on variable " & ActualVariable() & "----------"
Debug.Print "Excel formula: " & excelForm
Debug.Print "Excel second formula: " & excelForm2
Debug.Print Err.Description
End Sub

'Excel formula uses the OS to convert to local formula
Private Function ExcelFormula(ByVal formVal As String, _
ByVal validationTypes As Long) As Variant
Private Function ExcelFormula(ByVal formVal As String, _
ByVal validationTypes As Long, _
Optional ByVal useOS As Boolean = False) As Variant

Dim lData As ILinelistSpecs
Dim dict As ILLdictionary
@@ -622,30 +654,30 @@ Private Function ExcelFormula(ByVal formVal As String, _
If Not varFormObject.Valid(formulaType:="linelist") Then Exit Function
excelForm = varFormObject.ParsedLinelistFormula()
If FailedFormula(excelForm) Then Exit Function
'Removed conversion to OS formula on french desktops
'excelForm = OSFormula(excelForm)

excelForm = "= " & excelForm

'Removed conversion to OS formula on french desktops
If useOS Then
excelForm = OSFormula(excelForm)
Else
excelForm = "= " & excelForm
End If

If (Not varFormObject.HasLiterals) Then
If Not varFormObject.HasLiterals Then

'Return the required type
excelForm = Application.WorksheetFunction.Trim(Replace(excelForm, "=", ""))

Select Case validationTypes

Case xlValidateWholeNumber
convForm = CInt(excelForm)
Case xlValidateDate
convForm = CDate(excelForm)
Case xlValidateDecimal
convForm = CLng(excelForm)
End Select

ExcelFormula = convForm
Else

Else
'We have a formula, we just return the formula
ExcelFormula = excelForm
End If
@@ -694,7 +726,7 @@ Private Sub WriteInfo()
'Add conditional formatting
AddConditionalFormatting

'Addvalidation
'Addvalidation
On Error Resume Next
AddValidation
On Error GoTo 0

0 comments on commit c92c415

Please sign in to comment.