[Resolvido]Mudar de linha a cada nome

Boas tardes Amigos

No formulário que posto, como mudar de linha nos campos "Manhã", "Tarde", "Noite", "Descanso", "Férias" , sempre que mudar o nome.

Os nomes estão separados por virgula.

Exemplo

Dia 01/03/2018 Manhã ficava assim etc. :

José Carlos,
José Luís,
Teixeira,
Portelinha

Obrigado

Boa noite, Assis
Passa os campos para texto longo
substitui as vírgulas por
(através da função replace)
e voilá

Bom dia Alexandre

As virgulas estão lá por esta Rotina da sua autoria.

Obrigado

Option Compare Database
Option Explicit
'código criado por Alexandre Neves
'em 2012-12-15
'para dteixa
'do fórum MaximoAccess

Sub CriaTurnos()
On Error Resume Next
Dim RstOperadores As Dao.Recordset, RstTurnos As Dao.Recordset, RstAusencias As Dao.Recordset
Dim dtData As Date, Inicio As Date, Fim As Date, Turno As Byte

Set RstOperadores = CurrentDb.OpenRecordset("SELECT * FROM Operadores;")
Set RstTurnos = CurrentDb.OpenRecordset("SELECT * FROM Turnos;")
Set RstAusencias = CurrentDb.OpenRecordset("SELECT Letra,Inicio,Fim FROM Ausencias LEFT JOIN Operadores ON Ausencias.Operador=Operadores.Nome;")
Inicio = Forms!Rotina!Inicio
Fim = Forms!Rotina!Fim

''''
CurrentDb.Execute "DELETE * FROM Turnos"
''''
For dtData = Inicio To Fim
RstTurnos.AddNew
RstTurnos(1) = dtData

RstAusencias.MoveFirst
Do While Not RstAusencias.EOF
If dtData >= RstAusencias("Inicio") And dtData <= RstAusencias("Fim") Then RstTurnos("Ausencia") = RstTurnos("Ausencia") & RstAusencias("Letra") & ","
RstAusencias.MoveNext
Loop
If Not IsNull(RstTurnos("Ausencia")) Then RstTurnos("Ausencia") = Mid(RstTurnos("Ausencia"), 1, Len(RstTurnos("Ausencia")) - 1)
For Turno = 1 To Forms!Rotina!NTurnos
If RstOperadores.EOF Then RstOperadores.MoveFirst
Verifica1:
If InStr(1, RstTurnos("Ausencia"), RstOperadores("Letra")) > 0 Then
If RstOperadores.EOF Then RstOperadores.MoveFirst Else RstOperadores.MoveNext
GoTo Verifica1
End If

RstTurnos(Turno + 1) = RstOperadores("Letra")
RstOperadores.MoveNext
If RstOperadores.EOF Then RstOperadores.MoveFirst
Verifica2:
If InStr(1, RstTurnos("Ausencia"), RstOperadores("Letra")) > 0 Then
If RstOperadores.EOF Then RstOperadores.MoveFirst Else RstOperadores.MoveNext
GoTo Verifica2
End If

RstTurnos(Turno + 1) = RstTurnos(Turno + 1) & "," & RstOperadores("Letra")
RstOperadores.MoveNext
If RstOperadores.EOF Then RstOperadores.MoveFirst
Verifica3:
If InStr(1, RstTurnos("Ausencia"), RstOperadores("Letra")) > 0 Then
If RstOperadores.EOF Then RstOperadores.MoveFirst Else RstOperadores.MoveNext
GoTo Verifica3
End If

RstTurnos(Turno + 1) = RstTurnos(Turno + 1) & "," & RstOperadores("Letra")
RstOperadores.MoveNext
If RstOperadores.EOF Then RstOperadores.MoveFirst
Verifica4:
If InStr(1, RstTurnos("Ausencia"), RstOperadores("Letra")) > 0 Then
If RstOperadores.EOF Then RstOperadores.MoveFirst Else RstOperadores.MoveNext
GoTo Verifica4
End If

RstTurnos(Turno + 1) = RstTurnos(Turno + 1) & "," & RstOperadores("Letra")
RstOperadores.MoveNext

Next

RstTurnos.Update

Next

RstTurnos.MoveFirst
Do While Not RstTurnos.EOF
RstOperadores.MoveFirst

RstTurnos.Edit

Do While Not RstOperadores.EOF

If InStr(1, RstTurnos(2) & RstTurnos(3) & RstTurnos(4) & RstTurnos("Ausencia"), RstOperadores("Letra")) = 0 Then
RstTurnos("Descanso") = RstTurnos("Descanso") & RstOperadores("Letra") & ","
End If

If RstOperadores.EOF Then RstOperadores.MoveFirst Else RstOperadores.MoveNext
Loop
If Right(RstTurnos("Descanso"), 1) = "," Then RstTurnos("Descanso") = Mid(RstTurnos("Descanso"), 1, Len(RstTurnos("Descanso")) - 1)
RstTurnos.Update
RstTurnos.MoveNext
Loop
Set RstTurnos = Nothing: Set RstOperadores = Nothing

End Sub

Bom dia, Assis

Código:

Option Compare Database
Option Explicit
'código criado por Alexandre Neves
'em 2012-12-15
'para dteixa
'do fórum MaximoAccess

Sub CriaTurnos()
On Error Resume Next
Dim RstOperadores As Dao.Recordset, RstTurnos As Dao.Recordset, RstAusencias As Dao.Recordset
Dim dtData As Date, Inicio As Date, Fim As Date, Turno As Byte

Set RstOperadores = CurrentDb.OpenRecordset("SELECT * FROM Operadores;")
Set RstTurnos = CurrentDb.OpenRecordset("SELECT * FROM Turnos;")
Set RstAusencias = CurrentDb.OpenRecordset("SELECT Letra,Inicio,Fim FROM Ausencias LEFT JOIN Operadores ON Ausencias.Operador=Operadores.Nome;")
Inicio = Forms!Rotina!Inicio
Fim = Forms!Rotina!Fim

''''
CurrentDb.Execute "DELETE * FROM Turnos"
''''
For dtData = Inicio To Fim
RstTurnos.AddNew
RstTurnos(1) = dtData

RstAusencias.MoveFirst
Do While Not RstAusencias.EOF
If dtData >= RstAusencias("Inicio") And dtData <= RstAusencias("Fim") Then RstTurnos("Ausencia") = RstTurnos("Ausencia") & RstAusencias("Letra") & "<br>"
RstAusencias.MoveNext
Loop
If Not IsNull(RstTurnos("Ausencia")) Then RstTurnos("Ausencia") = Mid(RstTurnos("Ausencia"), 1, Len(RstTurnos("Ausencia")) - 1)
For Turno = 1 To Forms!Rotina!NTurnos
If RstOperadores.EOF Then RstOperadores.MoveFirst
Verifica1:
If InStr(1, RstTurnos("Ausencia"), RstOperadores("Letra")) > 0 Then
If RstOperadores.EOF Then RstOperadores.MoveFirst Else RstOperadores.MoveNext
GoTo Verifica1
End If

RstTurnos(Turno + 1) = RstOperadores("Letra")
RstOperadores.MoveNext
If RstOperadores.EOF Then RstOperadores.MoveFirst
Verifica2:
If InStr(1, RstTurnos("Ausencia"), RstOperadores("Letra")) > 0 Then
If RstOperadores.EOF Then RstOperadores.MoveFirst Else RstOperadores.MoveNext
GoTo Verifica2
End If

RstTurnos(Turno + 1) = RstTurnos(Turno + 1) & "<br>" & RstOperadores("Letra")
RstOperadores.MoveNext
If RstOperadores.EOF Then RstOperadores.MoveFirst
Verifica3:
If InStr(1, RstTurnos("Ausencia"), RstOperadores("Letra")) > 0 Then
If RstOperadores.EOF Then RstOperadores.MoveFirst Else RstOperadores.MoveNext
GoTo Verifica3
End If

RstTurnos(Turno + 1) = RstTurnos(Turno + 1) & "<br>" & RstOperadores("Letra")
RstOperadores.MoveNext
If RstOperadores.EOF Then RstOperadores.MoveFirst
Verifica4:
If InStr(1, RstTurnos("Ausencia"), RstOperadores("Letra")) > 0 Then
If RstOperadores.EOF Then RstOperadores.MoveFirst Else RstOperadores.MoveNext
GoTo Verifica4
End If

RstTurnos(Turno + 1) = RstTurnos(Turno + 1) & "<br>" & RstOperadores("Letra")
RstOperadores.MoveNext

Next

RstTurnos.Update

Next

RstTurnos.MoveFirst
Do While Not RstTurnos.EOF
RstOperadores.MoveFirst

RstTurnos.Edit

Do While Not RstOperadores.EOF

If InStr(1, RstTurnos(2) & RstTurnos(3) & RstTurnos(4) & RstTurnos("Ausencia"), RstOperadores("Letra")) = 0 Then
RstTurnos("Descanso") = RstTurnos("Descanso") & RstOperadores("Letra") & "<br>"
End If

If RstOperadores.EOF Then RstOperadores.MoveFirst Else RstOperadores.MoveNext
Loop
If Right(RstTurnos("Descanso"), 1) = "<br>" Then RstTurnos("Descanso") = Mid(RstTurnos("Descanso"), 1, Len(RstTurnos("Descanso")) - 1)
RstTurnos.Update
RstTurnos.MoveNext
Loop
Set RstTurnos = Nothing: Set RstOperadores = Nothing

End Sub

Boa tarde Alexandre


Ficou assim:

E o campo foi mudado para texto longo?

Sim Alexandre

Boa noite Alexandre

Resolvido