[Resolvido] Alterar Formato Moeda VBA - Excel

[nioxys]

Olá

Tenho um ficheiro Excel que é usado para fazer orçamentos e uma vez que os orçamentos podem ser feitos em vários tipos de moeda, Euro, Dólar, etc eu estou a tentar arranjar uma forma de alterar o formato das células que estão formatadas como moeda através de uma combobox. Ou seja, o utilizador selecciona na combobox a moeda a utilizar naquele orçamento e as células formatadas como moeda assumem essa "moeda", por exemplo, se o utilizador escolher dólar a célula passa a apresentar os valores 100,00 USD ou $100,00 (depende como eu colocar o formato).

Já consegui fazer isto no entanto funciona apenas para intervalos finitos, ou seja, A1:A100 por exemplo. Mas eu não sei se os itens de um orçamento vão terminar na linha 100 ou se num qualquer caso vou ter 500 linhas. Para além disso eu tenho várias colunas com diversas células formatadas como moeda. O que estou a tentar fazer é tornar o meu código dinâmico.

Neste momento tenho o seguinte,

Eu leio o formato inicial através de uma combobox, por exemplo, se a combobox estiver como EUR isso significa que as células estão formatadas naquele momento como EUR, então eu uso o evento DropButtonclick() para obter o estado inicial e passo esse valor para uma variável global chamada oldformat.

Código:

Private Sub ComboBox1_DropButtonclick()
inicial = Me.ComboBox1.Value
Select Case inicial
Case "EUR"
oldformat = "# ##0,00 €"
Case "GBP"
oldformat = "£#,##0.00"
Case "USD"
oldformat = "# ##0.00\ [$USD]"
End Select
End Sub

A variável oldformat é declarada,

Código:

Public oldformat As String

Depois disto eu uso o evento change da combobox para ler o novo valor, e coloco-o na variável newformat.

Código:

Private Sub ComboBox1_Change()

Dim ws As Worksheet
Dim newFormat As String

newValue = Me.ComboBox1.Value
Select Case newValue
Case "EUR"
newFormat = "# ##0,00 €"
Case "GBP"
newFormat = "£#,##0.00"
Case "USD"
newFormat = "# ##0.00\ [$USD]"
End Select

For Each ws In ActiveWorkbook.Worksheets

        Application.FindFormat.NumberFormat = oldformat
        Application.ReplaceFormat.NumberFormat = newFormat
        ws.Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
Next ws
End Sub

E ao mesmo tempo tento fazer um find/replace pelo livro do excel de forma a substituir o formato inicial pelo novo e aqui está o problema.
Não estou a conseguir atribuir o valor das variáveis oldformat e newformat à propriedade Numberformat

Obtenho o erro Run-time error '1004': Application-defined or object-defined error nas linhas

Código:

Application.FindFormat.NumberFormat = oldformat
Application.ReplaceFormat.NumberFormat = newFormat

Já tentei,

Código:

Application.FindFormat.NumberFormat = "oldformat"
Application.ReplaceFormat.NumberFormat = "newFormat"

Também não funciona.

Conhecem alguma forma de atribuir o valor destas variáveis à propriedade NumberFormat?
Ou alguém tem ideia de como fazer isto, outro método, outra abordagem, etc, estou receptivo a novas ideias.

Obrigado.

[nioxys]

Com a ajuda de um membro de um outro forum consegui chegar a uma solução.

Variáveis globais,

Código:

Option Explicit

Dim OldFormat As String, NewFormat As String

Função para buscar o formato actual

Código:

Private Function GetFormat(ByVal Value) As String
 Select Case UCase(Value)
   Case "EUR"
     GetFormat = "#,##0 $"
   Case "GBP"
     GetFormat = "[$£-809]#,##0"
   Case "USD"
     GetFormat = "#,##0 [$USD]"
 End Select
End Function

Utilização do evento GotFocus da combobox para ler o formato actual,

Código:

Private Sub ComboBox1_GotFocus()
 'Get the old format
 OldFormat = GetFormat(ComboBox1.Value)
End Sub

A substituição do formato utilizando o evento LostFocus da combobox,

Código:

[code]Private Sub ComboBox1_LostFocus()
 
 Dim Ws As Worksheet
 
 NewFormat = GetFormat(ComboBox1.Value)
 
 If OldFormat = "" Then Exit Sub
 If NewFormat = "" Then Exit Sub

 On Error GoTo ApplyFormat
 
 With Application.FindFormat
   .Clear
   .NumberFormat = OldFormat
 End With
 With Application.ReplaceFormat
   .Clear
   .NumberFormat = NewFormat
 End With
 'Replace all
 For Each Ws In Worksheets
   Ws.UsedRange.Replace "", "", SearchFormat:=True, ReplaceFormat:=True
 Next
 Exit Sub

ApplyFormat:
 
 Dim SaveFormat As String
 On Error GoTo ExitPoint
 SaveFormat = ActiveCell.NumberFormat
 ActiveCell.NumberFormat = GetFormat("EUR")
 ActiveCell.NumberFormat = GetFormat("GBP")
 ActiveCell.NumberFormat = GetFormat("USD")
 ActiveCell.NumberFormat = SaveFormat
 
 Resume
ExitPoint:
End Sub

Fica aqui um ficheiro com um exemplo.

Download - Ficheiro Exemplo[/code]