Aumenta altezza riga in base valore cella

[trittico69]

Salve spero di postare nel posto giusto.
Salve qualcuno mi può girare una macro che aumenta l'altezza(che inserirò io) della riga se la cella A5:A100 ha un valore, altrimenti l'altezza (riga con cella iniziale vuota) avrà un altezza sempre che imposterò io?
Grazie

[trittico69]

E poi uno simile che invece di aumentare la riga Mi inserisce una riga sopra la cella piena sempre della colonna A

[trittico69]

E poi che mi permetto di eliminare queste righe una volta che ho ripulito la colonna
Perché altrimenti quello che è scritto più in giù va a finire nel secondo foglio

[Dylan666]

Sposto nella sezione corretta

[Anthony47]

Ovviamente le opzioni (aumentare l’altezza di righe / inserire una riga) sono alternative, devi scegliere se attuare l’una o l’altra.
Per variare l’altezza di una riga a seconda che la colonna A di quella riga sia vuota o piena:

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
'Imposta altezza se Celle non vuote
'
Dim ckArea As String, defH As Single, enhH As Single
Dim myArea As Object, myC As Range
'
'Imposta i parametri:
ckArea = "A1:A100"      '<<< L'area da esaminare
defH = 22               '<<< L'Altezza in pixel se cella vuota
enhH = 44               '<<< . . . . . . . . . .se cella piena
'
Set myArea = Application.Intersect(Target, Range(ckArea))
If Not myArea Is Nothing Then
    For Each myC In myArea
        If myC.Value = "" Then
            myC.EntireRow.RowHeight = defH
        Else
            myC.EntireRow.RowHeight = enhH
        End If
    Next myC
End If
End Sub


Le righe marcate <<< sono da personalizzare come da commento

Per inserire/togliere riga:

Codice: Seleziona tutto

 Private Sub Worksheet_Change(ByVal Target As Range)
'Aggiunge /Toglie riga vuota prima di Target
'    USARE CON CAUTELA
'
Dim ckArea As String, defH As Single, enhH As Single
Dim myArea As Object, myC As Range
'
'Imposta i parametri:
''ckArea = "A1:A100"      '<<< L'area da esaminare NO: Vedi TESTO
'
Set myArea = Application.Intersect(Target, Range("ckArea"))
If Not myArea Is Nothing Then
    Application.EnableEvents = False
    For Each myC In myArea
        If myC.Value = "" Then
            If Application.WorksheetFunction.CountA(myC.Offset(-1, 0).EntireRow) = 1 And _
               myC.Offset(-1, 0).Value = " . " Then
                myC.Offset(-1, 0).EntireRow.Delete Shift:=xlUp
            Else
                Beep
            End If
        Else
            If myC.Offset(-1, 0).Value <> " . " Then
                myC.EntireRow.Insert Shift:=xlDown
                myC.Offset(-1, 0).Value = " . "         'Marker di riga aggiunta
            End If
        End If
    Next myC
    Application.EnableEvents = True
End If
End Sub

Come avrai notato non viene usato il valore di ckArea per definire l’area da esaminare; perche’ man mano che aggiungi righe l’area dovrebbe essere aggiornata. Si potrebbe fare via macro, ma il mio suggerimento e’ che nel foglio di lavoro crei un intervallo a cui assegni il nome ckArea:
-selezioni A1:A100 (se questa e’ l’area su cui si vuol lavorare); nella “Casella Nome” di Excel (quella che si trova a sinistra della “Barra delle Formula” e che normalmente contiene l’indirizzo della cella) scrivi ckArea e premi Enter
In questo modo quando eventualmente inserisci e togli righe l’intervallo di lavoro viene automaticamente allungato /accorciato.
Per evitare di cancellare righe non volute o di aggiungerne piu’ di una, la colonna A della riga aggiunta viene compilata col valore “ . “ (spazio-punto-spazio) e uso questo contenuto per decidere cosa fare (evitare di cancellare righe in modo indesiderato ed evitare di inserire piu’ righe modificando la stessa cella piu’ volte

Ambedue le macro sono di tipo “WorkSheet-Change”, una o l’altra va inserita nel “modulo vba del foglio su cui lavori”. Per fare questo:
-tasto dx sul tab col nome del foglio di lavoro; seleziona Visualizza codice; copia il codice e incollalo nella pagina del vba che si e’ aperta.
-modifica le righe da personalizzare

Poi torna sul foglio excel e prova

TUTTE LE PROVE DA FARE SU UNA COPIA DEL VERO FILE

[trittico69]

Ok grazie, Mi sono dimenticato di dirti una cosa, la riga che viene aumentata d'altezza dovrebbe anche comparire un bordo nella parte alta di tutta la riga.

[Anthony47]

Per inserire (e togliere) il bordo aggiungi le due istruzioni marcate +++

Codice: Seleziona tutto

    For Each myC In myArea
        If myC.Value = "" Then
            myC.EntireRow.RowHeight = defH
            myC.EntireRow.Borders(xlEdgeTop).LineStyle = xlNone     '+++
        Else
            myC.EntireRow.RowHeight = enhH
            myC.EntireRow.Borders(xlEdgeTop).Weight = xlThick       '+++
        End If
    Next myC


Fai sapere...

[trittico69]

Scusami non sono stato molto chiaro , il bordo della riga superiore deve andare dalla colonna A alla colonna G

[trittico69]

poi mi da errore
For Each myC In myArea
se scrivo al di fuori della colonna A

[trittico69]

ok sono riuscito a togliere l'errore , però andrebbe fatta una modifica e cioè le righe devono cambiare d'altezza solo se scrivo nella colonna A , attuamente mi aumenta l'altezza anche se scrivo nelle altre colonne

[Anthony47]

Mi copi tutto il codice presente nel modulo vba del foglio di lavoro? (il modulo che contiene la Sub Worksheet_Change)

[trittico69]

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
'Imposta altezza se Celle non vuote
'
Dim ckArea As String, defH As Single, enhH As Single
Dim myArea As Object, myC As Range
'
'Imposta i parametri:
ckArea = "A5:g32"      '<<< L'area da esaminare
defH = 15               '<<< L'Altezza in pixel se cella vuota
enhH = 20              '<<< . . . . . . . . . .se cella piena
'
Set myArea = Application.Intersect(Target, Range(ckArea))


For Each myC In myArea
        If myC.Value = "" Then
            myC.EntireRow.RowHeight = defH
            myC.EntireRow.Borders(xlEdgeTop).LineStyle = xlNone     '+++
        Else
            myC.EntireRow.RowHeight = enhH
            myC.EntireRow.Borders(xlEdgeTop).Weight = xlThick       '+++
        End If
    Next myC
    End Sub



[trittico69]

se metto A5:A32 mi da errore che dicevo prima

[Anthony47]

Perche' hai tolto questa riga??

Codice: Seleziona tutto

If Not myArea Is Nothing Then


(e il relativo End If)

Che problemi hai usando il codice che ti avevo suggerito, e che ti riepilogo qui:

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
'Imposta altezza se Celle non vuote
'
Dim ckArea As String, defH As Single, enhH As Single
Dim myArea As Object, myC As Range
'
'Imposta i parametri:
ckArea = "A1:A100"      '<<< L'area da esaminare
defH = 22               '<<< L'Altezza in pixel se cella vuota
enhH = 44               '<<< . . . . . . . . . .se cella piena
'
Set myArea = Application.Intersect(Target, Range(ckArea))
If Not myArea Is Nothing Then
    For Each myC In myArea
        If myC.Value = "" Then
            myC.EntireRow.RowHeight = defH
            myC.EntireRow.Borders(xlEdgeTop).LineStyle = xlNone    '+++
        Else
            myC.EntireRow.RowHeight = enhH
            myC.Resize(1, 6).Borders(xlEdgeTop).Weight = xlThick       '+++
        End If
    Next myC
End If
End Sub


(completo della modifica per inserire il bordo e della NUOVA modifica per inserirlo solo fino a colonna G)

[trittico69]

hai ragione con copia incolla si è persa quella riga, adesso va bene.

se per favore mi fai anche una macro
se C6 non è vuoto stampa solo il primo foglio,se C51 non è vuoto stampa i primi 2 fogli, se C96 non è vuoto stampa i primi tre fogli,se C141 non è vuoto stampa i primi 4 fogli, se C186 non è vuoto stampa i primi 5 fogli, se C231 non è vuoto stampa i primi 6 fogli, se C276 non è vuoto stampa i primi 7 fogli, se C321 non è vuoto stampa i primi 8 fogli, se C366 non è vuoto stampa i primi 9 fogli, tutte le celle menzionate contengono formule

[Anthony47]

hai ragione con copia incolla si è persa quella riga, adesso vca bene.
la riga evidenziata è sempre lunghissima

Nel messaggio di poco fa avevo anche inserito la modifica per mettere il bordo solo fino a colonna G; hai usato quel codice?

Per la nuova macro di stampa vedro' piu' tardi

[trittico69]

si fatto tutto ok

[trittico69]

adesso va bene tutto

[trittico69]

oltre alla macro di stampa , ho provato ad eliminare una riga e siccome le celle eliminate sono collegate con formula in altro foglio, c'è modo di far si che o aggiungo o elimino righe in automatico le coordinate celle formule si aggiornano?
ho preferito usare la macro di aumentere l'altezza delle righe e non l'aggiunta di righe.
te ne ho fatto fare tutte e due per vedere quale funzionava meglio.

[trittico69]

e se si puo tornare indietro, una volta partita la macro, anche solo di qualche passo