Salve, sono sempre impegnato con un modulo per fatture dove in alcune celle (da E30 a E45) devo inserire delle descrizioni dei prodotti che in alcuni casi si dispongono su più righe e quindi l'altezza standard della riga di 12.75 non è adeguata a visualizzarne il contenuto. Le celle da E30 a E45 sono celle unite (in orizzontale - dalla colonna E alla colonna I ) e il dato è caricato in automatico con la convalida da elenco (è impostato anche l'allineamento/testo a capo). Avete una macro che dopo l'inserimento dei dati imposti l'altezza della cella/riga in modo da vedere completamente il contenuto oppure il mio problema si risolve in altro modo? Vi ringrazio MF

Ciao MecFala , Perche non vedo il thread Salvare cartella da modello con assegnazione nome senza andare molto indietro, vorrei informarti della seguente risposta http://answers.microsoft.com/it-it/office/forum/office_2013_release-customize/salvare-cartella-da-modello-assegnazione-nome/1e256937-415c-4a1a-86a6-b4007dd7f35a#LastReply === Regards, Norman

Ciao MecFala , Nota che ho inviato un post nel tuo thread di Novembre per sostituire/aggiornare i link per Microsoft OneDrive e DropBox. === Regards, Norman

Adattare altezza cella (riga) al contenuto.

Risposta accettata dall'autore della domanda

Anonimo

Ciao MecFala,

ho provato e direi che funziona (però mi ha ridotto la larghezza delle colonne!)

Ti allego il link sui file che ho utilizzato:

https://www.dropbox.com/s/anf13316wr4ohvr/Fatturazione.xlsm?dl=0

https://www.dropbox.com/s/inngg3eytohbj36/FatturazioneBis.xlsm?dl=0

Nel file Fatturazione vedi la situazione iniziale prima della macro.

Nel file fatturazioneBis si vede invece l'azione della macro che mi ha giustificato il testo ma ridotto le colonne.

Ho scaricato i tuoi due file.

Per quanto riguarda la riduzione della la larghezza delle colonne, credo che l'abbia sistemata.

Ho anche notato un potenziale problema con il codice originale: mentre l'altezza della cella sarebbe aumentata per accogliere testo più lungo, se il contenuto di una cella unita fosse sostituito da una stringa di testo più breve, oppure se il testo fosse cancellato, l'altezza della riga si conformerebbe ancora alla precedente testo più lungo. Ora ho risolto questo problema.

A questo proposito, ho introdotto una costante dAltezzaRigaDefault e il suo valore venga utilizzzata per impostare una altezza minima per il corpo delle fatture. Ho provvisoriamente dato un valore di 20 alla costante per fornire una leggera separazione visiva tra righe contigue nel testo fattura. Si può, naturalmente, sostituire questo valore predefinito con qualsiasi valore alternativo adatto.

Il codice della funzione segue:

'=========>>

Option Explicit

'--------->>

Public Sub AutoFitMergedCells(Rng As Range)

Dim rCell As Range, aCell As Range

Dim rArea As Range

Dim dCurrentRowHeight As Double

Dim dMergedCellRngWidth As Double

Dim dWidth As Double, dPossNewRowHeight As Double

Dim arrFirstColWidths() As Double

Dim iCtr As Long, jCtr As Long

Const dAltezzaRigaDefault As Double = 20 '<<=== Modifica

Const sFoglioFattura As String = "Fatturazione " '<<=== Modifica

Const sCelleUnite As String = "E30:I44" '<<=== Modifica

ReDim arrFirstColWidths(1 To Rng.Areas.Count)

For Each rArea In Rng.Areas

iCtr = iCtr + 1

arrFirstColWidths(iCtr) = rArea.Columns(1).ColumnWidth

Next rArea

On Error GoTo XIT

Application.ScreenUpdating = False

For Each rArea In Rng.Areas

jCtr = 0

For Each rCell In Rng.Columns(1).Cells

With rCell.MergeArea

If .WrapText = True Then

dCurrentRowHeight = dAltezzaRigaDefault

.RowHeight = dCurrentRowHeight

dWidth = rCell.ColumnWidth

For Each aCell In rCell.MergeArea

dMergedCellRngWidth = aCell.ColumnWidth _

+ dMergedCellRngWidth

Next aCell

.MergeCells = False

.Cells(1).ColumnWidth = dMergedCellRngWidth

.EntireRow.AutoFit

dPossNewRowHeight = .RowHeight + 5

.Cells(1).ColumnWidth = dWidth

.MergeCells = True

.RowHeight = IIf(dCurrentRowHeight > dPossNewRowHeight, _

dCurrentRowHeight, dPossNewRowHeight)

dCurrentRowHeight = 0

dWidth = 0

dMergedCellRngWidth = 0

dPossNewRowHeight = 0

End If

End With

Next rCell

jCtr = jCtr + 1

rArea.Columns(1).ColumnWidth = arrFirstColWidths(jCtr)

Next rArea

XIT:

Application.ScreenUpdating = True

End Sub

'<<=========

Tornando alla procedura Worksheet_Change nel modulo di codice del foglio Fatturazione, ho sostituito il tuo codice:

'=========>>

Private Sub Worksheet_Change(ByVal Target As Range)

Tester

End Sub

'<<=========

con la seguente versione:

'=========>>

Option Explicit

'--------->>

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Rng As Range, rCell As Range

Dim rngCorpoFattura As Range

Const sCorpoFattura As String = "E30:I44"

Set rngCorpoFattura = Me.Range(sCorpoFattura)

Set Rng = Intersect(rngCorpoFattura.Columns(1), Target)

If Not Rng Is Nothing Then

Call AutoFitMergedCells(Rng)

End If

End Sub

'<<=========

Nota, tral'altro, che ho limitato l'avvio della funzione AutoFitMergedCells alla modifica di una o più celle nella intersezione della colonna E con il corpo della fattura, cioè l'intervallo E30:E44. Nel caso della tua versione, il codice sarebbe avviato, spesso inutilmente, in risposta ad una modifica di qualsiasi cella del foglio. Nota anche che, la mia funzione agisce soltanto sulla riga/righe di interesse. anzichè l'intero corpo della fattura.