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!