Adjust menu for my Essbase classic add-in toolkit. I just got inspired by Smart View's Adjust functionality, except that here you may use color to identify adjusted cells!
Find the code below, as you'll see it may not be the most beautiful VBA code but it should be clean enough for your understanding - btw I let you traduce the comments!
Find the code below, as you'll see it may not be the most beautiful VBA code but it should be clean enough for your understanding - btw I let you traduce the comments!
Option Explicit
Private Sub cmdCancel_Click()
Unload usfAjuster
End
End Sub
Private Sub cmdOK_Click()
Dim cell As Range
Dim msg As Integer
If txtValue = "" Then
msg = MsgBox(getLocalizedLabel(getSpreadsheetLanguage, "frmDialAjust9"), , _
getLocalizedLabel(getSpreadsheetLanguage, "frmDialAjust1"))
ElseIf Not IsNumeric(txtValue) Then
msg = MsgBox(getLocalizedLabel(getSpreadsheetLanguage, "frmDialAjust10"), , _
getLocalizedLabel(getSpreadsheetLanguage, "frmDialAjust1"))
Else
'Augmenter ou diminuer les cellules sélectionnées selon un pourcentage fixe
If optAugDimPCent.Value = True Then
'Test si sélection non numérique
For Each cell In Selection
If IsNumeric(cell.Value) Then
cell.Value = cell.Value + (cell.Value / 100 * txtValue)
If chkCouleurCellules.Value = True Then
cell.Interior.ColorIndex = 36
Else
End If
Else
msg = MsgBox(getLocalizedLabel(getSpreadsheetLanguage, "frmDialAjust11") + " (" + cell.Address + ")", , _
getLocalizedLabel(getSpreadsheetLanguage, "frmDialAjust1"))
End If
Next cell
'Ajouter ou soustraire une valeur fixe aux cellules sélectionnées
ElseIf optAjouSous.Value = True Then
For Each cell In Selection
If IsNumeric(cell.Value) Then
cell.Value = cell.Value + txtValue
If chkCouleurCellules.Value = True Then
cell.Interior.ColorIndex = 36
Else
End If
Else
End If
Next cell
'Multiplier les cellules sélectionnées par une valeur fixe
ElseIf optMul.Value = True Then
For Each cell In Selection
If IsNumeric(cell.Value) Then
cell.Value = cell.Value * txtValue
If chkCouleurCellules.Value = True Then
cell.Interior.ColorIndex = 36
Else
End If
Else
End If
Next cell
'Diviser les cellules sélectionnées par une valeur fixe
ElseIf optDiv.Value = True Then
For Each cell In Selection
If IsNumeric(cell.Value) Then
cell.Value = cell.Value / txtValue
If chkCouleurCellules.Value = True Then
cell.Interior.ColorIndex = 36
Else
End If
Else
End If
Next cell
End If
Unload usfAjuster
End
End If
End Sub
Private Sub UserForm_Initialize()
'Gestion des libellés
usfAjuster.Caption = getLocalizedLabel(getSpreadsheetLanguage, "frmDialAjust1")
usfAjuster.optAugDimPCent.Caption = getLocalizedLabel(getSpreadsheetLanguage, "frmDialAjust2")
usfAjuster.optAjouSous.Caption = getLocalizedLabel(getSpreadsheetLanguage, "frmDialAjust3")
usfAjuster.optMul.Caption = getLocalizedLabel(getSpreadsheetLanguage, "frmDialAjust4")
usfAjuster.optDiv.Caption = getLocalizedLabel(getSpreadsheetLanguage, "frmDialAjust5")
usfAjuster.cmdOK.Caption = getLocalizedLabel(getSpreadsheetLanguage, "frmDialAjust6")
usfAjuster.cmdCancel.Caption = getLocalizedLabel(getSpreadsheetLanguage, "frmDialAjust7")
usfAjuster.chkCouleurCellules.Caption = getLocalizedLabel(getSpreadsheetLanguage, "frmDialAjust8")
End Sub

Aucun commentaire:
Enregistrer un commentaire
your comment here please!