none
Codigo muito grande RRS feed

  • Pergunta

  • Boa noite

    Uso o codigo abaixo, funciona 100%, porem, o tamanho do mesmo é o problema, e pode aumentar.

    Tem algum codigo que substitua essa grande quantidade de For/Next?

    Private Sub UserForm_Activate() C = Format(Date, "mm"): LI = Format(Date, "dd") C = CStr(C) * 1 + 8: LI = CStr(LI) * 1 + 1 Y = Sheets("Apoio").Cells(LI, C) For X = 1 To Y Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HC0FFFF Next X 'Leitos de 1 a 3 For Z = 1 To 3 If Sheets("Apoio").Cells(Z + 1, 6) = "M" Then For X = 1 To 3 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HFFFF80 Controls("OptionButton" & X).Caption = "Leito " & X & " - M" Next X Exit For End If If Sheets("Apoio").Cells(Z + 1, 6) = "F" Then For X = 1 To 3 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HC0C0FF Controls("OptionButton" & X).Caption = "Leito " & X & " - F" Next X Exit For End If Next Z 'Leitos de 4 a 6 For Z = 4 To 6 If Sheets("Apoio").Cells(Z + 1, 6) = "M" Then For X = 4 To 6 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HFFFF80 Controls("OptionButton" & X).Caption = "Leito " & X & " - M" Next X Exit For End If If Sheets("Apoio").Cells(Z + 1, 6) = "F" Then For X = 4 To 6 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HC0C0FF Controls("OptionButton" & X).Caption = "Leito " & X & " - F" Next X Exit For End If Next Z 'Leitos de 7 a 9 For Z = 7 To 9 If Sheets("Apoio").Cells(Z + 1, 6) = "M" Then For X = 7 To 9 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HFFFF80 Controls("OptionButton" & X).Caption = "Leito " & X & " - M" Next X Exit For End If If Sheets("Apoio").Cells(Z + 1, 6) = "F" Then For X = 7 To 9 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HC0C0FF Controls("OptionButton" & X).Caption = "Leito " & X & " - F" Next X Exit For End If Next Z 'Leitos de 10 a 12 For Z = 10 To 12 If Sheets("Apoio").Cells(Z + 1, 6) = "M" Then For X = 10 To 12 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HFFFF80 Controls("OptionButton" & X).Caption = "Leito " & X & " - M" Next X Exit For End If If Sheets("Apoio").Cells(Z + 1, 6) = "F" Then For X = 10 To 12 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HC0C0FF Controls("OptionButton" & X).Caption = "Leito " & X & " - F" Next X Exit For End If Next Z 'Leitos de 13 a 18 For Z = 13 To 18 If Sheets("Apoio").Cells(Z + 1, 6) = "M" Then For X = 13 To 18 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HFFFF80 Controls("OptionButton" & X).Caption = "Leito " & X & " - M" Next X Exit For End If If Sheets("Apoio").Cells(Z + 1, 6) = "F" Then For X = 13 To 18 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HC0C0FF Controls("OptionButton" & X).Caption = "Leito " & X & " - F" Next X Exit For End If Next Z 'Leitos de 19 a 21 For Z = 19 To 21 If Sheets("Apoio").Cells(Z + 1, 6) = "M" Then For X = 19 To 21 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HFFFF80 Controls("OptionButton" & X).Caption = "Leito " & X & " - M" Next X Exit For End If If Sheets("Apoio").Cells(Z + 1, 6) = "F" Then For X = 19 To 21 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HC0C0FF Controls("OptionButton" & X).Caption = "Leito " & X & " - F" Next X Exit For End If Next Z 'Leitos de 22 a 24 For Z = 22 To 24 If Sheets("Apoio").Cells(Z + 1, 6) = "M" Then For X = 22 To 24 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HFFFF80 Controls("OptionButton" & X).Caption = "Leito " & X & " - M" Next X Exit For End If If Sheets("Apoio").Cells(Z + 1, 6) = "F" Then For X = 22 To 24 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HC0C0FF Controls("OptionButton" & X).Caption = "Leito " & X & " - F" Next X Exit For End If Next Z 'Leitos de 25 a 26 For Z = 25 To 26 If Sheets("Apoio").Cells(Z + 1, 6) = "M" Then For X = 25 To 26 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HFFFF80 Controls("OptionButton" & X).Caption = "Leito " & X & " - M" Next X Exit For End If If Sheets("Apoio").Cells(Z + 1, 6) = "F" Then For X = 25 To 26 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HC0C0FF Controls("OptionButton" & X).Caption = "Leito " & X & " - F" Next X Exit For End If Next Z 'Leitos de 27 a 28 For Z = 27 To 28 If Sheets("Apoio").Cells(Z + 1, 6) = "M" Then For X = 27 To 28 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HFFFF80 Controls("OptionButton" & X).Caption = "Leito " & X & " - M" Next X Exit For End If If Sheets("Apoio").Cells(Z + 1, 6) = "F" Then For X = 27 To 28 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HC0C0FF Controls("OptionButton" & X).Caption = "Leito " & X & " - F" Next X Exit For End If Next Z 'Leitos de 29 a 30 For Z = 29 To 30 If Sheets("Apoio").Cells(Z + 1, 6) = "M" Then For X = 29 To 30 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HFFFF80 Controls("OptionButton" & X).Caption = "Leito " & X & " - M" Next X Exit For End If If Sheets("Apoio").Cells(Z + 1, 6) = "F" Then For X = 29 To 30 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HC0C0FF Controls("OptionButton" & X).Caption = "Leito " & X & " - F" Next X Exit For End If Next Z 'Leitos de 31 a 32 For Z = 31 To 32 If Sheets("Apoio").Cells(Z + 1, 6) = "M" Then For X = 31 To 32 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HFFFF80 Controls("OptionButton" & X).Caption = "Leito " & X & " - M" Next X Exit For End If If Sheets("Apoio").Cells(Z + 1, 6) = "F" Then For X = 31 To 32 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HC0C0FF Controls("OptionButton" & X).Caption = "Leito " & X & " - F" Next X Exit For End If Next Z 'Leitos de 33 a 34 For Z = 33 To 34 If Sheets("Apoio").Cells(Z + 1, 6) = "M" Then For X = 33 To 34 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HFFFF80 Controls("OptionButton" & X).Caption = "Leito " & X & " - M" Next X Exit For End If If Sheets("Apoio").Cells(Z + 1, 6) = "F" Then For X = 33 To 34 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HC0C0FF Controls("OptionButton" & X).Caption = "Leito " & X & " - F" Next X Exit For End If Next Z 'Leitos de 35 a 36 For Z = 35 To 36 If Sheets("Apoio").Cells(Z + 1, 6) = "M" Then For X = 35 To 36 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HFFFF80 Controls("OptionButton" & X).Caption = "Leito " & X & " - M" Next X Exit For End If If Sheets("Apoio").Cells(Z + 1, 6) = "F" Then For X = 35 To 36 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HC0C0FF Controls("OptionButton" & X).Caption = "Leito " & X & " - F" Next X Exit For End If Next Z 'Leitos de 37 a 38 For Z = 37 To 38 If Sheets("Apoio").Cells(Z + 1, 6) = "M" Then For X = 37 To 38 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HFFFF80 Controls("OptionButton" & X).Caption = "Leito " & X & " - M" Next X Exit For End If If Sheets("Apoio").Cells(Z + 1, 6) = "F" Then For X = 37 To 38 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HC0C0FF Controls("OptionButton" & X).Caption = "Leito " & X & " - F" Next X Exit For End If Next Z 'Leitos de 39 a 40 For Z = 39 To 40 If Sheets("Apoio").Cells(Z + 1, 6) = "M" Then For X = 39 To 40 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HFFFF80 Controls("OptionButton" & X).Caption = "Leito " & X & " - M" Next X Exit For End If If Sheets("Apoio").Cells(Z + 1, 6) = "F" Then For X = 39 To 40 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HC0C0FF Controls("OptionButton" & X).Caption = "Leito " & X & " - F" Next X Exit For End If Next Z 'Leitos de 41 a 42 For Z = 41 To 42 If Sheets("Apoio").Cells(Z + 1, 6) = "M" Then For X = 41 To 42 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HFFFF80 Controls("OptionButton" & X).Caption = "Leito " & X & " - M" Next X Exit For End If If Sheets("Apoio").Cells(Z + 1, 6) = "F" Then For X = 41 To 42 Controls("OptionButton" & X).Enabled = True Controls("OptionButton" & X).Font.Bold = True Controls("OptionButton" & X).BackColor = &HC0C0FF Controls("OptionButton" & X).Caption = "Leito " & X & " - F" Next X Exit For End If Next Z For X = 1 To Y If Sheets("Apoio").Cells(X + 1, 5) = "Pac" Or Sheets("Apoio").Cells(X + 1, 5)= "Bloc" Then

    Controls("OptionButton" & X).Enabled = False Controls("OptionButton" & X).Font.Bold = False Controls("OptionButton" & X).BackColor = &HE0E0E0 End If Next X End sub

    Obrigado.
    terça-feira, 3 de dezembro de 2013 23:05

Respostas

  • Boa noite

    O codigo funcionou muito bem.

    A Fúlvio Cezar Canducci Dias, Anderson Apdo de Souza e Felipe Costa Gualberto (Benzadeus), agradeco atenção dispensada.

    • Marcado como Resposta JLNunes sábado, 7 de dezembro de 2013 23:01
    sábado, 7 de dezembro de 2013 23:01

Todas as Respostas

  • Em cada rotina dessa você poderia substituir por um function que paramentros

     If Sheets("Apoio").Cells(Z + 1, 6) = "F" Then
       For X = 39 To 40
        Controls("OptionButton" & X).Enabled = True
        Controls("OptionButton" & X).Font.Bold = True
        Controls("OptionButton" & X).BackColor = &HC0C0FF
        Controls("OptionButton" & X).Caption = "Leito " & X & " - F"
       Next X
      Exit For
     End If

    Como isso repete bastante mas, tem paramentros parecidos se poderia construir uma function com os dados pertinentes a todas rotinas, ia diminuir bem!

    Fulvio Cezar Canducci Dias


    sexta-feira, 6 de dezembro de 2013 03:39
  • boa noite

    como seria o codigo?

    obrigado

    sexta-feira, 6 de dezembro de 2013 22:33
  • Exatamente como o Fúlvio comentou.

    Basta utilizar uma técnica de refatoração  chamada Extrair Método. o código ficaria mais ou menos assim:

    Obs: não entendo muito de VB.

        Public Sub Controls(ByVal enable As Boolean, ByVal font As Boolean, ByVal backColor As Integer)
    
            Controls("OptionButton" & X).Enabled = enable
            Controls("OptionButton" & X).Font.Bold = font
            Controls("OptionButton" & X).BackColor = backColor
    
        End Sub

    E no lugar destas linhas repetidas você adiciona a function Controls, passando os parâmetros que você precisa preencher.

    O nome dos parâmetros é só um exemplo pra você entender, o correto é pensar em um nome mais sugestivo. 

    Abraço.

    sexta-feira, 6 de dezembro de 2013 23:18
  • Exatamente como o Fúlvio comentou.

    Basta utilizar uma técnica de refatoração  chamada Extrair Método. o código ficaria mais ou menos assim:

    Obs: não entendo muito de VB.

        Public Sub Controls(ByVal enable As Boolean, ByVal font As Boolean, ByVal backColor As Integer)
    
            Controls("OptionButton" & X).Enabled = enable
            Controls("OptionButton" & X).Font.Bold = font
            Controls("OptionButton" & X).BackColor = backColor
    
        End Sub

    E no lugar destas linhas repetidas você adiciona a function Controls, passando os parâmetros que você precisa preencher.

    O nome dos parâmetros é só um exemplo pra você entender, o correto é pensar em um nome mais sugestivo. 

    Abraço.

    Só mude Controls para outro nome !!! é mais ou menos assim

    Fulvio Cezar Canducci Dias

    sábado, 7 de dezembro de 2013 12:53
  • Declare suas variáveis!

    http://www.ambienteoffice.com.br/officevba/declaracao_de_variavel/

    ---

    Private Sub UserForm_Activate()
      C = Format(Date, "mm"): LI = Format(Date, "dd")
      C = CStr(C) * 1 + 8: LI = CStr(LI) * 1 + 1
      Y = Sheets("Apoio").Cells(LI, C)
      
      For X = 1 To Y
        Controls("OptionButton" & X).Enabled = True
        Controls("OptionButton" & X).Font.Bold = True
        Controls("OptionButton" & X).BackColor = &HC0FFFF
      Next X
      
      fncGetLeitos 1, 3
      fncGetLeitos 4, 6
      fncGetLeitos 7, 9
      fncGetLeitos 10, 12
      fncGetLeitos 19, 21
      fncGetLeitos 22, 24
      fncGetLeitos 25, 26
      fncGetLeitos 27, 28
      fncGetLeitos 29, 30
      fncGetLeitos 31, 32
      fncGetLeitos 33, 34
      fncGetLeitos 35, 36
      fncGetLeitos 37, 38
      fncGetLeitos 39, 40
       
      For X = 1 To Y
        If Sheets("Apoio").Cells(X + 1, 5) = "Pac" Or Sheets("Apoio").Cells(X + 1, 5) = "Bloc" Then
          Controls("OptionButton" & X).Enabled = False
          Controls("OptionButton" & X).Font.Bold = False
          Controls("OptionButton" & X).BackColor = &HE0E0E0
        End If
      Next X
    End Sub
    
    Private Sub fncGetLeitos(lngMin As Long, lngMax As Long)
      Dim lngZ As Long
      Dim lngX As Long
      
      For lngZ = lngMin To lngMax
        If Sheets("Apoio").Cells(lngZ + 1, 6) = "M" Then
         For lngX = lngMin To lngMax
          Controls("OptionButton" & lngX).Enabled = True
          Controls("OptionButton" & lngX).Font.Bold = True
          Controls("OptionButton" & lngX).BackColor = &HFFFF80
          Controls("OptionButton" & lngX).Caption = "Leito " & lngX & " - M"
         Next lngX
        Exit For
        End If
       If Sheets("Apoio").Cells(lngZ + 1, 6) = "F" Then
         For lngX = lngMin To lngMax
          Controls("OptionButton" & lngX).Enabled = True
          Controls("OptionButton" & lngX).Font.Bold = True
          Controls("OptionButton" & lngX).BackColor = &HC0C0FF
          Controls("OptionButton" & lngX).Caption = "Leito " & lngX & " - F"
         Next lngX
        Exit For
       End If
       Next lngZ
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    sábado, 7 de dezembro de 2013 20:41
    Moderador
  • Boa noite

    O codigo funcionou muito bem.

    A Fúlvio Cezar Canducci Dias, Anderson Apdo de Souza e Felipe Costa Gualberto (Benzadeus), agradeco atenção dispensada.

    • Marcado como Resposta JLNunes sábado, 7 de dezembro de 2013 23:01
    sábado, 7 de dezembro de 2013 23:01