Search

A carregar...

About Me

A minha fotografia
JRod - PORTUGAL
Microsoft [MVP] - Excel (10º ano consecutivo)
Ver o meu perfil completo
Com tecnologia do Blogger.

Seguidores

Estatisticas

Free Blog Counter

eXTReMe Tracker
Ocorreu um erro neste dispositivo
2006-03-19
Se pretendermos que uma determinada célula sequencie sempre que quisermos abrir um workbook, podemos utilizar o seguinte código de McGimpsey, com a adaptação no código de abertura do workbook, uma vez que se incluiu no número sequencial o ano, no formato "nn/aa", com a porção de código & "/" & Right(Date, 2)

O código da Função NextSeqNumber():

Public Function NextSeqNumber(Optional sFileName As String, Optional nSeqNumber As Long = -1) As Long
    Const sDEFAULT_PATH As String = "C:\GABINETE"
    Const sDEFAULT_FNAME As String = "defaultseq.txt"
    Dim nFileNumber As Long

    nFileNumber = FreeFile
    If sFileName = "" Then sFileName = sDEFAULT_FNAME
    If InStr(sFileName, Application.PathSeparator) = 0 Then _
       sFileName = sDEFAULT_PATH & Application.PathSeparator & sFileName
    If nSeqNumber = -1& Then
        If Dir(sFileName) <> "" Then
            Open sFileName For Input As nFileNumber
            Input #nFileNumber, nSeqNumber
            nSeqNumber = nSeqNumber + 1&
            Close nFileNumber
        Else
            nSeqNumber = 1&
        End If
    End If
    On Error GoTo PathError
    Open sFileName For Output As nFileNumber
    On Error GoTo 0
    Print #nFileNumber, nSeqNumber
    Close nFileNumber
    NextSeqNumber = nSeqNumber
    Exit Function
PathError:
    NextSeqNumber = -1&
End Function


NOTA:
sDEFAULT_PATH e sDEFAULT_FNAME indicados a título de exemplo, podendo ser, como óbvio, alterados.

NOTA:
A célula onde recai o valor sequencial, deve ser formatada como texto.

O Código de abertura do Workbook:

Private Sub Workbook_Open()

ThisWorkbook.Sheets(1).Range("B2").Value = NextSeqNumber & "/" & Right(Date, 2)

End Sub



O resultado:


2006-03-04
Por vezes, podemos ter a necessidade e utilizar, num Userform, um TextBox com comprimento fixo e com Multiline e WordWrap. Vejamos o exemplo:



Quando se inicia a escrita, a altura do TextBox aumenta automaticamente até à altura previamente definida:



Grava para a célula A1:



Para invocar o Userform que contem o TextBox, criamos um CommandButton na grelha:



O Código para o Comando:

Private Sub CommandButton1_Click()
    FrmTeste.Show
End Sub


Os códigos em VBA:



Private Sub TextBox1_Change()

    TextBox1.Width = 150
    TextBox1.MultiLine = True
    TextBox1.WordWrap = True
    TextBox1.AutoSize = False

    With Me.TextBox1
        .Height = 80
    End With

End Sub




Private Sub CommandButton1_Click()
    Range("A1") = TextBox1.Value
End Sub