LISTVIEW DATA E DIA DA SEMANA

ALANTB 23/08/2012 13:02:47
#408450
Olá pessoal, tenho o código descrito abaixo que carrega um Listview com dias do mês, horários de trabalho e valores. Gostaria de inserir mais uma rotina: de acordo com o dia do mês que é carregado na coluna 1, mostrar na coluna 2 (inserir coluna nova) o respectivo dia da semana. E para piorar ainda mais: se for sabado, domingo ou feriado os valores a partir da 3° coluna devem vir em branco, pois nesses dias da semana, no sistema em questão, não é dia trabalhado. Alguma idéia??????
Segue o código que estou usando:

Private Sub cmdGerar_Click()

l = txtTotalDiasTrabalhados.Text [ô] Quantidade de DIAS
Dim MyArray(30) As Date [ô] Indica que o numero Maximo de DIAS será 30
Dim i As Integer
MyArray(0) = txtDataInicial.Text [ô] Indica que Myarray começara no (0) que será o valor de txtdatainicial
For i = 1 To l [ô] Indica que (i) irá de 0 até o Valor de (l)
MyArray(i) = DateAdd([Ô]d[Ô], i, txtDataInicial) [ô] indica que Myarray Somara o Valor de (i) que será o Numero de dias e (d) indica o dia
Dim lst As ListItem
Set lst = ListView1.ListItems.Add(, , Text)
lst.ListSubItems.Add Text:=Format(MyArray(i), [Ô]dd/mm/yyyy[Ô]) [ô] Indica que O Numero de dias Será Inserido em lst
lst.ListSubItems.Add Text:=Me.txtEntrada.Text
lst.ListSubItems.Add Text:=Me.txtSaida.Text
lst.ListSubItems.Add Text:=Me.txtEntrada2.Text
lst.ListSubItems.Add Text:=Me.txtSaida2.Text
lst.ListSubItems.Add Text:=Format(Me.ComboBox_CargaHorariaDia, [Ô]h:mm[Ô])
lst.ListSubItems.Add Text:=ComboBox_ValorHora.Text
lst.ListSubItems.Add Text:=txtValorReceber.Text


Next [ô] Indica que tera que voltar no começo até que Myarray seja do mesmo valor de (l)
ExportaParaPlanilha

Limpar2
End Sub
GOODSPEAKERS 23/08/2012 13:32:28
#408455
DIA DA SEMANA

Public Function DiaSemana(vDia As Date) As String
Select Case Weekday(vDia)
Case 1
DiaSemana = [Ô]Domingo[Ô]
Case 2
DiaSemana = [Ô]Segunda-Feira[Ô]
Case 3
DiaSemana = [Ô]Terça-Feira[Ô]
Case 4
DiaSemana = [Ô]Quarta-Feira[Ô]
Case 5
DiaSemana = [Ô]Quinta-Feira[Ô]
Case 6
DiaSemana = [Ô]Sexta-Feira[Ô]
Case 7
DiaSemana = [Ô]Sábado[Ô]
End Select
End Function


ULTIMO DIA DO MES

Public Function UltimoDia(ByVal D As Date) As Date

Dim D2 As Variant

UltimoDia = DateSerial(Year(D), Month(D) + 1, 0)

End Function


SOMAR HORAS
Public Function SOMAHORA(HORA1 As String, HORA2 As String) As String

Dim Hora As Long
Dim Min As Long
Dim sRet

Hora = CLng(Left(HORA1, InStr(1, HORA1, [Ô]:[Ô]) - 1))
Hora = CLng(Left(HORA2, InStr(1, HORA2, [Ô]:[Ô]) - 1)) - Hora

Min = CLng(Right(HORA1, 2))
Min = Min + CLng(Right(HORA2, 2))

If Min >= 60 Then
Hora = Hora + 1
Min = Min - 60
End If

sRet = Format(Hora & [Ô]:[Ô] & Format(Min, [Ô]00[Ô]), [Ô]short time[Ô])

SOMAHORA = sRet

End Function

DIFERENCA DE HORAS

Public Function DifHoras(Entrada As Date, Saida As Date) As String
[ô]Calcula a diferença entra as horas

Dim H1 As Integer
Dim M1 As Integer
Dim H2 As Integer
Dim M2 As Integer
Dim Rh As Integer
Dim Rm As Integer
H1 = Mid(Entrada, 1, 2)
M1 = Mid(Entrada, 4, 2)
H2 = Mid(Saida, 1, 2)
M2 = Mid(Saida, 4, 2)
[ô]
If H1 < H2 And M1 > M2 Then Rh = H2 - H1 - 1
[ô]
If H2 > H1 Then
If M2 < M1 Then
Rm = 60 - M1
Rm = Rm + M2
End If
If M2 > M1 Then
Rh = H2 - H1
Rm = M2 - M1
End If
If Rm > 60 Then
Rm = 60 - M1
Rm = Rm + M2
Rm = Rm - 60
End If
If Rm = 60 Then
Rm = 0
End If
If Rm = 0 Then
If H2 > H1 Then
Rh = H2 - H1
Rm = 0
End If
End If

End If
[ô]
If H2 < H1 Then
If M2 < M1 Then
Rm = 60 - M1
Rm = Rm + M2
Rh = H2 + 24
Rh = Rh - H1 - 1
End If
If M2 > M1 Then
Rh = H2 + 24
Rh = Rh - H1
Rm = M2 - M1
End If
If Rm > 60 Then
Rm = 60 - M1
Rm = Rm + M2
Rm = Rm - 60
End If
If Rm = 60 Then
Rm = 0
End If
If Rm = 0 Then
If H2 < H1 Then
Rh = H2 + 24
Rh = Rh - H1
Rm = 0
End If
End If
End If
[ô]
If H2 = H1 Then
If M2 < M1 Then
Rh = H2 + 24
Rh = Rh - H1 - 1
Rm = 60 - M1
Rm = Rm + M2
End If
If M2 > M1 Then
Rh = H2 - H1
Rm = M2 - M1
End If
End If
[ô]
If H1 = H2 And M1 = M2 Then
Rh = 24
Rm = 0
MsgBox [Ô]Esse horário é muito longo !!![Ô], vbExclamation, [Ô]Atenção![Ô]
Exit Function
End If
If Rh = 0 Then Rh = Rh * -1
If Rm = 0 Then Rm = Rm * -1
If Rh > 24 Or Rm > 60 Then MsgBox [Ô]Informe um horário válido![Ô], vbExclamation, [Ô]Atenção![Ô]
If M1 >= 60 Or M2 >= 60 Or H1 > 24 Or H2 > 24 Then MsgBox [Ô]Informe um horário válido![Ô], vbExclamation, [Ô]Atenção![Ô]

DifHoras = Format(Rh, [Ô]00[Ô]) & [Ô]:[Ô] & Format(Rm, [Ô]00[Ô])

End Function
MARCELO.TREZE 23/08/2012 14:02:31
#408460 Resposta escolhida
bom minha dica coloque uma coluna com o seguinte código

Private Sub cmdGerar_Click()

l = txtTotalDiasTrabalhados.Text  [ô] Quantidade de DIAS
Dim MyArray(30) As Date [ô] Indica que o numero Maximo de DIAS será 30
Dim i As Integer
MyArray(0) = txtDataInicial.Text [ô] Indica que Myarray começara no (0) que será o valor de txtdatainicial
For i = 1 To l [ô] Indica que (i) irá de 0 até o Valor de (l)
MyArray(i) = DateAdd([Ô]d[Ô], i, txtDataInicial)  [ô] indica que Myarray Somara o Valor de (i) que será o Numero de dias e (d) indica o dia
Dim lst As ListItem
Set lst = ListView1.ListItems.Add(, , Text)
          lst.ListSubItems.Add Text:=Format(MyArray(i), [Ô]dd/mm/yyyy[Ô])     [ô] Indica que O Numero de dias Será Inserido em lst
          lst.ListSubItems.Add Text:=WeekdayName(Weekday((MyArray(i))) [txt-color=#007100][ô] ja vai retornar  o dia da semana (segunda, terça....)[/txt-color]
          If WeekDay(MyArray(i)) > 1 And WeekDay(MyArray(i) < 7 Then [txt-color=#007100][ô] Se for de segunda a sexta acrescenta o restante[/txt-color]
          lst.ListSubItems.Add Text:=Me.txtEntrada.Text
          lst.ListSubItems.Add Text:=Me.txtSaida.Text
          lst.ListSubItems.Add Text:=Me.txtEntrada2.Text
          lst.ListSubItems.Add Text:=Me.txtSaida2.Text
          lst.ListSubItems.Add Text:=Format(Me.ComboBox_CargaHorariaDia, [Ô]h:mm[Ô])
          lst.ListSubItems.Add Text:=ComboBox_ValorHora.Text
          lst.ListSubItems.Add Text:=txtValorReceber.Text
          End If
         
Next [ô] Indica que tera que voltar no começo até que Myarray seja do mesmo valor de (l)
ExportaParaPlanilha

Limpar2
End Sub


testa ai
ALANTB 24/08/2012 10:39:26
#408539
MARCELO-TREZE, fiz algumas pequenas modificações no código que enviaste e atendeu perfeitamente as minhas necessidades. Vou encerrar e pontuar...valeu!!!!!!
Tópico encerrado , respostas não são mais permitidas
Voltar