VBA Excel - Inserindo o caracter de barra ao formatar as Datas

| Blog Office VBA | Blog Excel | Blog Access | Blog Infochart | 

DESENVOLVO APLICAÇÕES VBA

Acesse uma ENORME lista de Dashboards e Infográficos

Aprenda a detectar gráficos que precisam mudar

Dados ou Informações?

Dashboards - 8 Importantes características desejáveis

Dashboards e Infocharts - Diversas Visualizações de Dados

Diversos exemplos de Gráficos

Excel - DashMap - Mapa do Brasil

Key Performance Indicators - 7 Características desejáveis

MIS - Usufruindo a excelência na análise das suas Informações

O Melhor do Business Intelligence

Os 10 mandamentos do gerenciamento de projetos

Receba 3 Calendários Customizáveis de  2013 em Excel

Usando Gauges em Dashboards no MS Access

Você tem direito as informações da sua empresa

A funcionalidade abaixo serve para deixar-nos mais à vontade ao inserir datas no MS Excel. 

Esta funcionalidade insere barras "/" para separar dd/mm/aa, ou seja, quando digitamos 05021972, será inserido uma formatação de barras na textbox, alterando o número digitado para 05/02/1972.

Public tx As String

Public k As Integer

Sub btnFormat_Click()

If Not IsDate(TextBox1) Then

  MsgBox "data inválida", vbInformation, "Saberexcel o site das macros"

  TextBox1.SetFocus

  

  Let TextBox1.SelStart = 10

  Let TextBox1.Text = ""

  TextBox1.SetFocus

Else

MsgBox "Data válida", vbInformation, "Saberexcel - o site das macros "

End If

End Sub

Sub TextBox1_KeyUp (ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

Dim z As String

If TextBox1 = "" Then TextBox1 = "--/--/----": k = 0: tx = "": TextBox1.SelStart = 0: Exit Sub

If KeyCode = 8 Then

If k <= 1 Then TextBox1 = "--/--/----": TextBox1.SelStart = 0: k = 0: tx = "": Exit Sub

     

     k = k - 1

    tx = Left(tx, k)

    z = Right("--/--/----", 10 - k)

   If Len(tx) = 3 Then tx = Left(tx, 2): k = 2: z = "/--/----"

   

   If Len(tx) = 6 Then tx = Left(tx, 5): k = 5: z = "/----"

      TextBox1 = tx & z

      TextBox1.SelStart = k

   Exit Sub

   End If

   

   If k >= 10 Then TextBox1 = Left(TextBox1, 10): Exit Sub

      k = k + 1

      tx = tx & Mid(TextBox1, k, 1)

      z = Right("--/--/----", 10 - Len(tx))

   

   If Len(tx) = 6 Then tx = Left(tx, 5) & "/" & Right(tx, 1): z = "-": k = k + 1

   If Len(tx) = 5 Then tx = tx & "/": z = "----": k = k + 1

   If Len(tx) = 3 Then tx = Left(tx, 2) & "/" & Right(tx, 1): z = "-/----": k = k + 1

   If Len(tx) = 2 Then tx = tx & "/": z = "--/----": k = k + 1

      TextBox1 = tx & z

      TextBox1.SelStart = k

End Sub

Pode tentar essas soluções:

DATE(RIGHT(A1,4), LEFT(A1),MID(A1,2,2))

=DATE(VALUE(RIGHT(A2,4)), VALUE(LEFT(A2,1)), VALUE(MID(A2,2,2)))

dDate = Dateserial(Mid(strDateTime, 1, 2), _
Mid(strDateTime, 5, 2), _
Mid(strDateTime, 3, 2))

Estude também a opção abaixo:

Sub Worksheet_Change (ByVal Target As Range)

    Select Case Target.Column

    Case 3, 5  ' columns C & E are 3rd & 5th columns

        Let TypedVal = Application.WorksheetFunction. _

            Text(Target.Value, "000000")

        Let NewValue = Left(TypedVal, 2) & "/" & _

            Mid(TypedVal, 3, 2) & "/" & _

            Right(TypedVal, 2)

    Case 4, 6 ' Columns D & F are time columns

        Let TypedVal = Application.WorksheetFunction. _

            Text(Target.Value, "0000")

        Let NewValue = Left(TypedVal, 2) & ":" & _

            Right(TypedVal, 2)

    End Select

    If NewValue > 0 Then

        Application.EnableEvents = False

        Let Target.Value = NewValue

        Let Application.EnableEvents = True

    End If

End Sub

Reference::

Shane Devenshire, 

microsoftexcel.com.br

http://www.mrexcel.com/sfsep2009.html

Tags: VBA, Excel, Barra, /, Date, format, slash