Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

concatena mantenendo formattazione

1,572 views
Skip to first unread message

Antonio

unread,
Jan 18, 2007, 3:10:00 PM1/18/07
to
riportando con "&" il contenuto di 5 celle iu un'unica vorrei poter mantenere
la formattazione di ogni singola cella ad esempio:

Cella A2 Pippo grandezza 10 normale
Cella A3 Pluto grandezza 10 grassetto
Cella A4 Paperino grandeza 10 corsivo
Cella A5 Gastone grandezza 10 normale
Cella A6 Paperone grandezza 11 colore rosso

in A8 il risultato mantenendo le varie formattazioni, si può fare?

Grazie in anticipo e un saluto a voi tutti
Antonio

elby

unread,
Jan 19, 2007, 8:50:51 AM1/19/07
to

Antonio ha scritto:

Caio Antonio
In VBA tutti i formati da te indicati sono proprietà di
lettura/scrittura. Una volta ricavati tipo e posizione, basterà
manipolare la proprietà Characters dell'oggetto Range che punta alla
cella A8 per ottenere quello che vuoi.
Ciao Elio

Antonio

unread,
Jan 19, 2007, 3:20:16 PM1/19/07
to

"elby" ha scritto:

>
> Caio Antonio
> In VBA tutti i formati da te indicati sono proprietà di
> lettura/scrittura. Una volta ricavati tipo e posizione, basterà
> manipolare la proprietà Characters dell'oggetto Range che punta alla
> cella A8 per ottenere quello che vuoi.
> Ciao Elio
>
>

Ciao Elby e grazie per chiarimento ... immaginavo che fosse una cosa
fattibile solo in VB ma le mie conoscenze di tale lingaggio sono praticamente
zero, oltre registrare qualche macro non varo, potresti aiutarmi facendomi un
esempio attenendoti ad esempio nel post iniziale che ho scritto? Ti ringrazio
anticipatamente e comunque, anche se non hai modo di esaudire la mia richiesta

Ciao
Antonio

elby

unread,
Jan 19, 2007, 10:52:01 PM1/19/07
to

Antonio ha scritto:

> Ciao Elby e grazie per chiarimento ... immaginavo che fosse una cosa
> fattibile solo in VB ma le mie conoscenze di tale lingaggio sono praticamente
> zero, oltre registrare qualche macro non varo, potresti aiutarmi facendomi un
> esempio attenendoti ad esempio nel post iniziale che ho scritto? Ti ringrazio
> anticipatamente e comunque, anche se non hai modo di esaudire la mia richiesta


Ciao Antonio
Il codice funziona con celle sulla stessa colonna. Da incollare nel
modulo di un foglio di lavoro e lanciare con F5 o da un pulsante sul
foglio stesso.
I valori dei formati ( nome, dimensione, stile e colore ) delle celle
del range selezionato vengono memorizzati in una matrice, insieme
alla lunghezza delle singole stringhe e al punto di inizio di queste
nella stringa di concatenazione finale. La matrice risultante ha quindi
una prima dimensione di 6 elementi. La seconda dimensione ovviamente
dipende dal numero di celle, in colonna, selezionate. Sfruttando la
proprietà Characters dell'oggetto Range, nella parte finale della
routine vengono impostati i valori dei formati leggendoli dalla
matrice. Da notare che la stringa inscritta nella cella finale deve
essere un valore letterale e non il prodotto di una formula. Infatti
non puoi, nemmeno manualmente, modificare il formato di solo parte
del testo restituito da una formula.
Ho voluto inserire nella routine anche la gestione del Font.Name
perché può essere utile concatenare carattetri convenzionali con
simboli speciali ( per esempio concatenare Arial + Wingdings2 ).
Ciao Elio

Sub ConcatenaStringheFormatiVariabili()
Dim myRange As Range
Dim myCell As Range
Dim myVar As Variant
Dim lngStart As Long
Dim arr As Variant
Dim lngRows As Long
Dim i As Long
Dim dest As Range
On Error Resume Next
Set myRange = Application.InputBox("Selezionare una colonna di celle",
, , , , , , 8)
If myRange Is Nothing Then
Exit Sub
ElseIf myRange.Columns.Count > 1 Then
MsgBox "selezionare un intervallo di una sola colonna", vbCritical
Exit Sub
End If
Set dest = Application.InputBox("Selezionare la cella di destinazione",
, , , , , , 8)
If dest Is Nothing Then
MsgBox "Non si è selezionata alcuna cella di destinazione.",
vbCritical
Exit Sub
End If
On Error GoTo 0
lngStart = 1
ReDim arr(1 To 6, 1 To myRange.Rows.Count)
For Each myCell In myRange
lngRows = lngRows + 1
With myCell.Font
arr(1, lngRows) = .Name
arr(2, lngRows) = .FontStyle
arr(3, lngRows) = .Size
arr(4, lngRows) = .ColorIndex
End With
arr(5, lngRows) = Len(myCell)
arr(6, lngRows) = lngStart
myVar = myVar & myCell.Value
lngStart = lngStart + Len(myCell)
Next myCell
Application.ScreenUpdating = False
dest.Range("A1") = myVar
For i = 1 To lngRows
Set myCell = dest.Range("A1")
With myCell.Characters(arr(6, i), arr(5, i)).Font
.Name = arr(1, i)
.FontStyle = arr(2, i)
.Size = arr(3, i)
.ColorIndex = arr(4, i)
End With
Next i
Application.ScreenUpdating = True

End Sub

Antonio

unread,
Jan 20, 2007, 8:56:00 AM1/20/07
to

"elby" ha scritto:

Ciao elby, ho provato e funziona, grazie per disponibilità e soprattutto per
le spiegazioni

Saluti
Antonio

0 new messages