mardi 30 mars 2010

Adjust menu for Essbase add-in

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!
Adjust menu for Essbase Excel add-in
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!