✔ Programação GLOBAL®: VBA Excel - Inserindo o caracter de barra ao formatar as Datas

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

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