CheckBox per inserire formule in vari fogli

Question

Ciao a tutti,

Ho ancora bisogno del vostro aiuto. Ho provato a creare il codice di quello che mi serve ma senza risultati. Ho un userform con 6 checkbox. Quando vado a spuntare alcune di esse, mi devono riportare la formula registrata nel codice su 12 fogli nella colonna A a partire dalla riga 10 fino a un massimo della trentesima riga. Ho pubblicato il file di esempio in modo che possa rendere meglio l’idea. Grazie per l’attenzione che manifestate.

https://skydrive.live.com/?cid=10afbffc368444d4#cid=10AFBFFC368444D4&id=10AFBFFC368444D4!113

Answer 1

Ciao Giudo,

se ho interpretato correttamente, modifica il codice relativo alla checkbox nr. 6 in questo modo:

---

.....

     If Chk6.Value = True Then

        Dim i As Long

        i = 13

        Do While lRiga < 29

            .Range("A" & lRiga).FormulaR1C1 = "=R" & i & "C3"

            .Range("A" & lRiga + 1).FormulaR1C1 = "=R" & i & "C4"

            lRiga = lRiga + 2

            i = i + 1

        Loop

    Else

        Chk6.Value = False

    End If

......

---

Nel caso fosse quello che cercavi, per maggiore chiarezza, sposta la dichiarazione della variabili i nella parte dichiarativa della tua routine.

David

Answer 2

David sei stato grandissimo, è proprio quello che cercavo. Ho spostato la variabile i nel modo che segue, fammi sapere se sta bene e grazie veramente per il tuo meraviglioso aiuto.

 If Chk6.Value = True Then

        Dim i As Long

        i = 13

        Do While lRiga < 29

            i = i + 1

            .Range("A" & lRiga).FormulaR1C1 = "=R" & i & "C3"

            .Range("A" & lRiga + 1).FormulaR1C1 = "=R" & i & "C4"

            lRiga = lRiga + 2    

        Loop

    Else

        Chk6.Value = False

    End If

Answer 3

Sono riuscito a sistemare il codice ottenendo quello che chiedevo. L’unica cosa che non riesco a sistemare è che non deve andare oltre la riga 28. Per capirci se dovessi spuntare la 1, 2 e 6 checkbox  mi deve compilare la colonna fino alla riga 28 aggiungendo della checkbox numero 6 solo le righe necessarie per arrivare alla riga 28. Spero di aver reso chiaro quello che è il mio problema. Il codice è quello che segue.

Private Sub CommandButton1_Click()

    Dim shArray As Sheets

    Dim sh As Worksheet

    Dim lRiga As Long

On Error GoTo RigaErrore

    Set shArray = ThisWorkbook.Worksheets(Array("Foglio1", "Foglio2", _

    "Foglio3", "Foglio4", "Foglio5", "Foglio6", "Foglio7", "Foglio8", _

    "Foglio9", "Foglio10", "Foglio11", "Foglio12"))

    For Each sh In shArray

    With sh

lRiga = .Range("A28").End(xlUp).Row + 1

.Range("A13:A28").ClearContents

    If .Range("A30").End(xlUp).Row < 13 Then

lRiga = 13

    End If

If Chk1.Value = True Then

.Range("A" & lRiga).Value = "=Base!C7"

lRiga = lRiga + 1

.Range("A" & lRiga).Value = "=Base!D7"

lRiga = lRiga + 1

Else

Chk1.Value = False

    End If

If Chk2.Value = True Then

.Range("A" & lRiga).Value = "=Base!C9"

lRiga = lRiga + 1

.Range("A" & lRiga).Value = "=Base!D9"

lRiga = lRiga + 1

Else

Chk2.Value = False

    End If

If Chk3.Value = True Then

.Range("A" & lRiga).Value = "=Base!C10"

lRiga = lRiga + 1

.Range("A" & lRiga).Value = "=Base!D10"

lRiga = lRiga + 1

Else

Chk3.Value = False

    End If

If Chk4.Value = True Then

.Range("A" & lRiga).Value = "=Base!C11"

lRiga = lRiga + 1

.Range("A" & lRiga).Value = "=Base!D11"

lRiga = lRiga + 1

Else

Chk4.Value = False

    End If

If Chk5.Value = True Then

.Range("A" & lRiga).Value = "=Base!C13"

lRiga = lRiga + 1

.Range("A" & lRiga).Value = "=Base!D13"

lRiga = lRiga + 1

Else

Chk5.Value = False

    End If

If Chk6.Value = True Then

.Range("A" & lRiga).Value = "=C13"

lRiga = lRiga + 1

.Range("A" & lRiga).Value = "=D13"

lRiga = lRiga + 1

.Range("A" & lRiga).Value = "=C14"

lRiga = lRiga + 1

.Range("A" & lRiga).Value = "=D14"

lRiga = lRiga + 1

.Range("A" & lRiga).Value = "=C15"

lRiga = lRiga + 1

.Range("A" & lRiga).Value = "=D15"

lRiga = lRiga + 1

.Range("A" & lRiga).Value = "=C16"

lRiga = lRiga + 1

.Range("A" & lRiga).Value = "=D16"

lRiga = lRiga + 1

.Range("A" & lRiga).Value = "=C17"

lRiga = lRiga + 1

.Range("A" & lRiga).Value = "=D17"

lRiga = lRiga + 1

.Range("A" & lRiga).Value = "=C18"

lRiga = lRiga + 1

.Range("A" & lRiga).Value = "=D18"

lRiga = lRiga + 1

.Range("A" & lRiga).Value = "=C19"

lRiga = lRiga + 1

.Range("A" & lRiga).Value = "=D19"

lRiga = lRiga + 1

.Range("A" & lRiga).Value = "=C20"

lRiga = lRiga + 1

.Range("A" & lRiga).Value = "=D20"

lRiga = lRiga + 1

Else

Chk6.Value = False

    End If

    End With

    Next

RigaChiusura:

    Set shArray = Nothing

    Set sh = Nothing

    Exit Sub

RigaErrore:

    MsgBox Err.Number & vbNewLine & Err.Description

    Resume RigaChiusura

End Sub

Answer 4

Il file che ho pubblicato riporta una userform con un codice che in pratica ho tentato di scrivere ma senza risultati, dice da quale foglio copiare e dove scrivere (l'esempio riporta il foglio2 ma a me servirebbe riportare le informazioni dal foglio2 al foglio13. il link è:

https://skydrive.live.com/?cid=10afbffc368444d4#cid=10AFBFFC368444D4&id=10AFBFFC368444D4!113

Il codice che ho tentato di scrivere è questo:

Private Sub CommandButton1_Click()

    Dim sh As Worksheet

    Dim lRiga As Long

  Set sh = ThisWorkbook.Worksheets("Foglio2")

 lRiga = sh.Range("A30").End(xlUp).Row + 1

    If sh.Range("A30").End(xlUp).Row < 10 Then

        lRiga = 10

    End If

     With Me

     If Chk1.Value = True Then

       sh.Range("A" & lRiga).Value = "=Foglio1!A1"

       sh.Range("A" & lRiga).Value = "=Foglio1!B1"

       Else

       Chk1.Value = False

    End If

     If Chk2.Value = True Then

        sh.Range("A" & lRiga).Value = "=Foglio1!A2"

        sh.Range("A" & lRiga).Value = "=Foglio1!B2"

        Else

        Chk2.Value = False

    End If

     If Chk3.Value = True Then

        sh.Range("A" & lRiga).Value = "=Foglio1!A3"

        sh.Range("A" & lRiga).Value = "=Foglio1!B3"

        Else

        Chk3.Value = False

    End If

     If Chk4.Value = True Then

        sh.Range("A" & lRiga).Value = "=Foglio1!A4"

        sh.Range("A" & lRiga).Value = "=Foglio1!B4"

        Else

        Chk4.Value = False

    End If

         If Chk5.Value = True Then

        sh.Range("A" & lRiga).Value = "=Foglio1!A5"

        sh.Range("A" & lRiga).Value = "=Foglio1!B5"

        Else

        Chk5.Value = False

    End If

     If Chk6.Value = True Then

        sh.Range("A" & lRiga).Value = "=Foglio1!A6"

        sh.Range("A" & lRiga).Value = "=Foglio1!B6"

        sh.Range("A" & lRiga).Value = "=Foglio1!A7"

        sh.Range("A" & lRiga).Value = "=Foglio1!B7"

        sh.Range("A" & lRiga).Value = "=Foglio1!A8"

        sh.Range("A" & lRiga).Value = "=Foglio1!B8"

        sh.Range("A" & lRiga).Value = "=Foglio1!A9"

        sh.Range("A" & lRiga).Value = "=Foglio1!B9"

        sh.Range("A" & lRiga).Value = "=Foglio1!A10"

        sh.Range("A" & lRiga).Value = "=Foglio1!B10"

        sh.Range("A" & lRiga).Value = "=Foglio1!A11"

        sh.Range("A" & lRiga).Value = "=Foglio1!B11"

        Else

        Chk6.Value = False

    End If

 End With

End Sub

Answer 5

Ciao a tutti,

Ho ancora bisogno del vostro aiuto.

<cut>

Non ho capito cosa vuoi fare, scusa.

Quando faccio click sul pulsante cosa deve succedere(in parole) e deve succedere su tutti e 10 i fogli contemporaneamente?

Grazie.