EXCELer: agosto 2007

2007-08-25

202: VBA - Userforms, Controls

8:01 da tarde |

Publicada por JRod - PORTUGAL |

Por mail, colocaram-me a seguinte pergunta (adaptada): "Estou pretendendo fazer o seguinte: Utilizar um formulário para alimentar dados numa folha. Existirá uma forma de quando mandar salvar (botão Adiciona), seja verificado se todos os campos foram preenchidos?"

A imagem do que se pretende:

O segmento de Código, apenas para o fim em vista:

For Each C In Me.Controls
     If TypeName(C) = "TextBox" Or TypeName(C) = "ComboBox" Then
       If C.Value = "" Then
         MsgBox "Por favor, preencha todos os campos!"
         C.SetFocus
         Exit Sub
       End If
     End If
   Next

Créditos para Bill Manville

Tópicos relacionados:

Loop Through Controls on a UserForm. Textbox, ComboBox, CheckBox etc

Utiliser les UserForm en VBA Excel

2007-08-17

201: VBA - Gerar números aleatórios com "rollup"

5:03 da tarde |

Publicada por JRod - PORTUGAL |

Editar mensagem

A propósito de uma questão (adaptada) que me foi colocada, via e-mail: "É possivel fazer um sorteio com uma apresentação onde eu veja os números rodando em cada caixa até parar no número sorteado? Ou seja, o programa estará gerando os números randomicamente num determinado período. Digamos que para gerar a primeira dezena ele ficará randomicamente num loop de 100 voltas e o centésimo número gerado será a primeira dezena sorteada (unidades), e assim sucessivamente até a última dezena (dezenas, centenas e milhares). Porém eu gostaria de ver cada um dos números sendo exibidos mesmo que em frações de milésimos.É possível?", aproveitei um segmento de código que "apanhei" na net e introduzi-lhe algumas alterações, para obter o efeito desejado.

A ideia, será a seguinte, nas duas imagens:

com a visualização de um "rollup" de números aleatórios até à sua fixação, seguindo-se a ordem descrita:

O Código:

Sub Macro1()
    Dim i, z, choice, balls(10)

    Range("A17").Select 'Para referência da ActiveCell

    For i = 0 To 9
        balls(i) = i
    Next

    Randomize Timer

    For i = 4 To 1 Step -1 ' da direita para a esquerda
        For z = 100 To 1 Step -1
            choice = 1 + Int((Rnd * (10 - 1)))
            ActiveCell.Offset(0, i - 1).Value = balls(choice)
        Next z
        balls(choice) = 0
    Next
End Sub

Tópicos relacionados:

2007-08-12

200: VBA - A Propriedade OFFSET e o Método INTERSECT

2:28 da tarde |

Publicada por JRod - PORTUGAL |

Editar mensagem

Num newsgroup, colocaram a seguinte questão: "Gostaria que nas células que o utilizador percorra, A1, A2, A3, onde vai depositando valores numericos, esses mesmos valores sejam automaticamente carregados para uma outra célula, que será sempre a mesma, por exemplo em C5, isto porque em C5 a cada valor percorrido na coluna A, vão sendo efectuados diversos cálculos baseados nos valores dos inputs que vão sendo feitos. Eu apenas consegui atingir este objectivo colocando um botão, que o utilizador deverá carregar, quando se posicionar em A1, A2, A3 etc, que copia os valores SEMPRE para C5. Mas isto obriga a que o utilizador carregue num botão o que não dá muito jeito".

Através do exemplo que se segue, entende-se o que é pretendido.

Supondo que a célula de input é uma das que compõem o Range A1:A10 e que a célula que vai receber igualmente o valor é C5: ao digitarmos o valor 3 em A5, C5 toma também o valor 3:

e ao digitarmos o valor 7 em A7, então C5 tomará igualmente esse valor, o mesmo se passando para as restantes células do Range A1:A10:

O Código:

Private Sub Worksheet_Change(ByVal Target As Range)
'JRod - Microsoft [MVP] - Excel
'blog: http://EXCELer.blogspot.com
'site: http://www.exceler.org
'email1: mail@exceler.org
'email2: blog.exceler@netcabo.pt
'
Const WS_RANGE As String = "A1:A10"
Dim vValor As Long

    On Error GoTo ws_exit
    Application.EnableEvents = False

    If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
        With Target
        ActiveCell.Offset(-1, 0).Activate
        vValor = Application.ActiveCell.Value
        Range("C5") = vValor
        End With
    End If

ws_exit:
    Application.EnableEvents = True

End Sub

Nota: O Código deve ser inserido no próprio módulo da Sheet activa.

Tópicos relacionados:

2007-08-10

199: VBA - Ordenação por linhas - Orientation:=xlLeftToRight

4:47 da tarde |

Publicada por JRod - PORTUGAL |

Editar mensagem

Há dias, num newsgroup, colocaram a questão de saber como se poderia ordenar um range dinâmico em termos de linhas, com o tipo de ordenação na horizontal (por linha) e da direita para a esquerda.

Tomemos o seguinte exemplo demonstrativo da pretensão e do consequente resultado:

O Código:

Sub SortRow()
'JRod
'
'Copyright 2007
   Dim R, RowNum As Long
   RowNum = ActiveSheet.UsedRange.Rows.Count
   For R = 2 To RowNum + 1
    Range("A" & R & ":E" & R).Sort key1:=Range("A" & R), _
        Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlLeftToRight
   Next R
End Sub