** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Access y VBA > Access y VBA
  Mensajes nuevos Mensajes nuevos RSS - Resumir código_2
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoResumir código_2
 Responder Responder
Autor
Mensaje
  Tema Buscar Tema Buscar  Opciones del Tema Opciones del Tema
mfafa Ver desplegable
Asiduo
Asiduo


Unido: 23/Septiembre/2009
Localización: España
Estado: Sin conexión
Puntos: 497 		Enlace directo a este mensaje Tema: Resumir código_2
    Enviado: 26/Mayo/2020 a las 16:55
Hola!,

Hace unos días me han ayudado muchísimo para Optimizar un código en este hilo

Ahora he añadido un campo "Festivo" Tipo (Sí/No) a la tabla, y lo que pretendo es cuando ese campo está marcado (Verdadero) que ponga el color rojo al contenido. 
He añadido el código en rojo a continuación: 

Private Sub Report_Activate()
Dim db As Database
Dim rstRecords As DAO.Recordset
Dim arrTexto(0 To 41)  As String
Dim i As Integer
Set rstRecords = CurrentDb.OpenRecordset("SELECT tblData.Month, tblData.Day, tblData.Year, tblData.Name, tblData.Event, tblData.Festivo FROM tblData", dbOpenDynaset)

For i = 0 To 41
  If Forms("frmCalander").Controls("Command" & i).Visible = True Then
    With rstRecords
      .FindFirst "[Day] =" & Forms("frmCalander").Controls("Command" & i).Caption & "And [Month] =" & "'" & Forms("frmCalander").Controls("cboMonth") & "'"
      Do While Not .NoMatch
        arrTexto(i) = IIf(IsNull(![Event]), arrTexto(i) & " " & ![Name] & Chr(13) + Chr(10), arrTexto(i) & ![Name] & " (" & ![Event] & ") " & Chr(13) + Chr(10))
        .FindNext "[Day] =" & Forms("frmCalander").Controls("Command" & i).Caption & "And [Month] =" & "'" & Forms("frmCalander").Controls("cboMonth") & "'"
      Loop
      arrTexto(i) = vbCrLf & arrTexto(i)
    End With
  Else
  End If
Next
i = 0
For i = 0 To 41

    Me.Controls("[Text" & i & "]").Visible = Forms("frmCalander").Controls("Command" & i).Visible
    Me.Controls("[Text" & i & "]").Value = " " & Forms("frmCalander").Controls("Command" & i).Caption & arrTexto(i)
    If rstRecords.Fields(5) <> 0 Then
    Me.Controls("[Text" & i & "]").ForeColor = RGB(255, 0, 0)
    End If 
Next i
rstRecords.Close
Set rstRecords = Nothing

End Sub


Editado por mfafa - 26/Mayo/2020 a las 17:30
Arriba
xavi Ver desplegable
Administrador
Administrador
Avatar
Terrassa-BCN

Unido: 10/Mayo/2005
Localización: Catalunya ||||
Estado: Sin conexión
Puntos: 14738 		Enlace directo a este mensaje Enviado: 26/Mayo/2020 a las 18:27
Cositas
- Se supone que el campo TextX está en el mismo formulario frmCalander... --> el Me. no deberia funcionar
- No es necesario asignar el valor 0 a la variable i si a continuación la meterás en un For Next
- No te hace falta un segundo bloque For..Next: lo puedes meter al final del primero
- Intenta no referenciar un campo del recordset por su posición. Si mañana añades un campo intermedio, el código no funciona. Utilizar el nombre del campo es mucho más robusto.

Private Sub Report_Activate()
Dim db As Database
Dim rstRecords As DAO.Recordset
Dim arrTexto(0 To 41)  As String
Dim i As Integer
Set rstRecords = CurrentDb.OpenRecordset("SELECT tblData.Month, tblData.Day, tblData.Year, tblData.Name, tblData.Event, tblData.Festivo FROM tblData", dbOpenDynaset)

For i = 0 To 41
  If Forms("frmCalander").Controls("Command" & i).Visible = True Then
    With rstRecords
      .FindFirst "[Day] =" & Forms("frmCalander").Controls("Command" & i).Caption & "And [Month] =" & "'" & Forms("frmCalander").Controls("cboMonth") & "'"
      Do While Not .NoMatch
        arrTexto(i) = IIf(IsNull(![Event]), arrTexto(i) & " " & ![Name] & Chr(13) + Chr(10), arrTexto(i) & ![Name] & " (" & ![Event] & ") " & Chr(13) + Chr(10))
        .FindNext "[Day] =" & Forms("frmCalander").Controls("Command" & i).Caption & "And [Month] =" & "'" & Forms("frmCalander").Controls("cboMonth") & "'"
      Loop
      arrTexto(i) = vbCrLf & arrTexto(i)
    End With
  Else
  End If

  Forms("frmCalander").Controls("Text" & i).Visible = Forms("frmCalander").Controls("Command" & i).Visible
  Forms("frmCalander").Controls("Text" & i).Value = " " & Forms("frmCalander").Controls("Command" & i).Caption & arrTexto(i)
  If rstRecords!Festivo Then  
	Forms("frmCalander").Controls("Text" & i).ForeColor = vbRed
  End If
Next i

rstRecords.Close
Set rstRecords = Nothing

End Sub


Un saludo
Xavi, un minyó de Terrassa

Mi web
Arriba
mfafa Ver desplegable
Asiduo
Asiduo


Unido: 23/Septiembre/2009
Localización: España
Estado: Sin conexión
Puntos: 497 		Enlace directo a este mensaje Enviado: 26/Mayo/2020 a las 18:42
Hola!,

Ha funcionado a la perfección!!!! ClapClapClapClapClapClapClapClapClapClap

Tan solo una puntualización:-

El campo TextX está en el informe  --> el Me. funciona.

Así quedó el código:

Dim db As Database
Dim rstRecords As DAO.Recordset
Dim arrTexto(0 To 41)  As String
Dim i As Integer
Set rstRecords = CurrentDb.OpenRecordset("SELECT tblData.Month, tblData.Day, tblData.Year, tblData.Name, tblData.Event, tblData.Festivo FROM tblData", dbOpenDynaset)

For i = 0 To 41
  If Forms("frmCalander").Controls("Command" & i).Visible = True Then
    With rstRecords
      .FindFirst "[Day] =" & Forms("frmCalander").Controls("Command" & i).Caption & "And [Month] =" & "'" & Forms("frmCalander").Controls("cboMonth") & "'"
      Do While Not .NoMatch
        arrTexto(i) = IIf(IsNull(![Event]), arrTexto(i) & " " & ![Name] & Chr(13) + Chr(10), arrTexto(i) & ![Name] & " (" & ![Event] & ") " & Chr(13) + Chr(10))
        .FindNext "[Day] =" & Forms("frmCalander").Controls("Command" & i).Caption & "And [Month] =" & "'" & Forms("frmCalander").Controls("cboMonth") & "'"
      Loop
      arrTexto(i) = vbCrLf & arrTexto(i)
    End With
  Else
  End If

  Me.Controls("[Text" & i & "]").Visible = Forms("frmCalander").Controls("Command" & i).Visible
  Me.Controls("[Text" & i & "]").Value = " " & Forms("frmCalander").Controls("Command" & i).Caption & arrTexto(i)
  If rstRecords!Festivo Then
    Me.Controls("[Text" & i & "]").ForeColor = vbRed
  End If
Next i

rstRecords.Close
Set rstRecords = Nothing

Muchas gracias maestro.

Se puede cerrar el hilo.
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable