A abordagem seguinte faz uso de uma alternativa descrita aqui e aqui para permitir uma função de folha de trabalho definida em VBA para definir o valor de outra célula.
A função personalizada armazena em variáveis globais o endereço da célula de destino e o valor para o qual essa célula deve ser definida. Depois, uma macro que é accionada quando a folha de trabalho recalcula lê as variáveis globais e define a célula-alvo para o valor especificado.
A utilização da função personalizada é simples:
=SetCellValue(target_cell, value)
onde target_cell
é uma referência em cadeia a uma célula da folha de trabalho (por exemplo, “A1”) ou uma expressão que avalia uma tal referência. Isto inclui uma expressão como =B14
em que o valor de B14 é “A1”. A função pode ser utilizada em qualquer expressão válida.
SetCellValue
devolve 1 se o valor for escrito com sucesso na célula alvo, e 0 caso contrário. Qualquer conteúdo anterior da célula-alvo é sobrescrito.
São necessários três pedaços de código:
- o código que define
SetCellValue
ele próprio
- a macro que é accionada pelo evento de cálculo da folha de trabalho; e
- uma função utilitária
IsCellAddress
para assegurar que target_cell
é um endereço válido da célula.
Código para a Função SetCellValue
Este código precisa de ser colado num módulo padrão inserido na pasta de trabalho. O módulo pode ser inserido através do menu do editor Visual Basic, ao qual se acede seleccionando Visual Basic
a partir do separador Developer
da fita.
Option Explicit
Public triggerIt As Boolean
Public theTarget As String
Public theValue As Variant
Function SetCellValue(aCellAddress As String, aValue As Variant) As Long
If (IsCellAddress(aCellAddress)) And _
(Replace(Application.Caller.Address, "$", "") <> _
Replace(UCase(aCellAddress), "$", "")) Then
triggerIt = True
theTarget = aCellAddress
theValue = aValue
SetCellValue = 1
Else
triggerIt = False
SetCellValue = 0
End If
End Function
Folha de trabalho_Calcular código macro
Este código deve ser incluído no código específico da folha de trabalho em que se vai utilizar SetCellValue
. A forma mais fácil de o fazer é clicar com o botão direito do rato no separador da folha de trabalho na visualização Home
, seleccionar View Code
, e depois colar o código no painel do editor que aparece.
Private Sub Worksheet_Calculate()
If Not triggerIt Then
Exit Sub
End If
triggerIt = False
On Error GoTo CleanUp
Application.EnableEvents = False
Range(theTarget).Value = theValue
CleanUp:
Application.EnableEvents = True
Application.Calculate
End Sub
Código para a Função IsCellAddress
Este código pode ser colado no mesmo módulo que o código SetCellValue
.
Function IsCellAddress(aValue As Variant) As Boolean
IsCellAddress = False
Dim rng As Range ' Input is valid cell reference if it can be
On Error GoTo GetOut ' assigned to range variable
Set rng = Range(aValue)
On Error GoTo 0
Dim colonPos As Long 'convert single cell "range" address to
colonPos = InStr(aValue, ":") 'single cell reference ("A1:A1" -> "A1")
If (colonPos <> 0) Then
If (Left(aValue, colonPos - 1) = _
Right(aValue, Len(aValue) - colonPos)) Then
aValue = Left(aValue, colonPos - 1)
End If
End If
If (rng.Rows.Count = 1) And _
(rng.Columns.Count = 1) And _
(InStr(aValue, "!") = 0) And _
(InStr(aValue, ":") = 0) Then
IsCellAddress = True
End If 'must be single cell address in this worksheet
Exit Function
GetOut:
End Function