problema con il grassetto

Hai un problema con Excel?

Nuova discussione

problema con il grassetto..
di skiro (utente non iscritto) data: 24/01/2014 15:54:10
buon giorno a tutto il forum..
ho un problema con l'esecuzione di una routine....

il mio programma scorre una seri di righe e colonne con due cicli for annidati....
il valore di ogni cella lo copia in un avariabile di tipo variant e lo concatena tutto in un'altra variabile di tipo variant inserendo dei trattini esempio: TestoTotale = TestoTotale & " - " & Testo

infine la variabile TestoTotale viene scritta in una particolare cella :Cells(4, 34).Value = TestoTotale
fin qui ok. ma voglio aggiungere una cosa.... quando la cella selezionata è presente un colore di riempimento vorrei che il testo sia trasformato in grassetto.
mi perdo quando penso al fatto che non posso trasformarlo in grassetto nel momento che è posto nella varianbile ma solo quando è mstato scritto nella cella.... vero?
mi basterebbe vedere un esempio o sapere quale funzione
grazie e saluti a tutti
di patel data: 24/01/2014 16:51:35
allega un file di esempio con la tua macro, dovrebbe bastare qualsosa del genere
if Cells(r, c).interior.colorindex <> -4142 then Cells(r, c).font.bold = true endif

di Grograman (utente non iscritto) data: 24/01/2014 16:54:36
Mi era venuta un idea... ma ho visto che funziona al primo colpo, dopo sovrascrive resettando il formato....

Option Explicit

Sub Sgrassa()
Dim sN As String
Dim i As Long, x As Long

For i = 1 To 30
  sN = sN & Range("A" & i).Value & " "
  Range("B1") = sN
  If Range("A" & i).Interior.Pattern <> xlNone Then
    x = Len(Range("A" & i).Text)
    With Range("B1").Characters(Start:=Len(sN) - x, Length:=x).Font
      .FontStyle = "Grassetto"
    End With
  End If
Next i

di skiro (utente non iscritto) data: 24/01/2014 22:33:02
posto la mia routine...

questo codice:
if Cells(r, c).interior.colorindex <> -4142 then
Cells(r, c).font.bold = terue
endif
questo codice farebbe diventare grassetto il testo dentro la cella con il relativo colore di riempimento.

ma io devo prima copiare il testo di ogni cella concatenarlo tutto e mettere in grassetto solo il testo che proviene da una cella con il colore di sfondo per esempio giallo e rosso.

per la risposto di Grograman
sono un po' in difficolta perche non riesco ancora a decifrare tutto il codice....

grazie a tutti per le risposte.... continuo a provare....
saluti

Sub Pulsante1_Click()
Dim riga, colonna As Integer
Dim Testo, TestoTotale As Variant


For riga = 4 To 36
    For colonna = 1 To 31
    If Cells(riga, colonna) <> "" Then
    Testo = Cells(riga, colonna)
    TestoTotale = TestoTotale & " - " & Testo
    Cells(4, 34).Value = TestoTotale
    End If
    If riga = 4 And colonna = 1 Then  'questa parte solo per inizializzare la stringa
    TestoTotale = "Mancolista: " & Testo
    End If
    Next colonna
Next riga

skiro
di skiro data: 24/01/2014 22:50:07
ho provato la parte di Grograman
ed ho notato che quando trova una cella con uno efondo colorato fa diventare tutto il testo presente nella cella B1 in grassetto.
invece a me serve che diventi in grassetto il solo testo presente nelle celle "colorate".

saluti

di gaetanopr data: 25/01/2014 19:13:39
Ciao, un paio di osservazioni sul tuo codice
Dim riga, colonna As Integer
Dim Testo, TestoTotale As Variant

In questo modo dimensioni in integer solo colonna, riga è variant, stessa cosa per la seconda riga anche se in questo caso sono entrambe variant
Testo e TestoTotale sono di tipo stringa, quindi inutile dichiararle variant, riga deve essere dichiarata Long, invece colonna potrebbe andare bene integer.

Nella mia macro ho usato due array, si potrebbe usare una matrice bidimensionale
Fai sapere se è quello che volevi

Allego pure file

Option Explicit

Sub grassetto()
Dim riga As Long, colonna As Long
Dim Testo As String, TestoTotale As String
Dim Inizio As Long, GrassI() As Long, GrassL() As Long, i As Long
Dim a As Long, x As Long, y As Long


For riga = 1 To 5
   For colonna = 1 To 2
     If Cells(riga, colonna) <> "" Then
         Testo = Cells(riga, colonna)
         TestoTotale = TestoTotale & "-" & Testo
         Cells(1, 7).Value = TestoTotale
         If Cells(riga, colonna).Interior.ColorIndex <> -4142 Then
            x = Len(Cells(riga, colonna))
            y = Len(Cells(1, 7))
            Inizio = (y - x) + 1
            ReDim Preserve GrassI(0 To a)
            ReDim Preserve GrassL(0 To a)
            GrassI(a) = Inizio
            GrassL(a) = x
            a = a + 1
         End If
      End If
    Next colonna
Next riga

For i = 0 To UBound(GrassI)
  With Cells(1, 7).Characters(Start:=GrassI(i), Length:=GrassL(i)).Font
      .FontStyle = "Grassetto"
  End With
Next i
End Sub

di gaetanopr (utente non iscritto) data: 25/01/2014 21:55:57
Allego un'altra versione

Sub grassetto3()
Dim riga As Long, colonna As Long
Dim Testo As String, TestoTotale() As String
Dim Inizio As Long, i As Long, n As Long
Dim a As Long, x As Long, y As Long, Lunghezza As Long
ReDim Grass(1, 0)

For colonna = 1 To 2
   For riga = 1 To 250
     If Cells(riga, colonna) <> "" Then
         Testo = Cells(riga, colonna)
         ReDim Preserve TestoTotale(0 To n)
         TestoTotale(n) = Testo
         Lunghezza = Lunghezza + Len(Testo) + 1
         n = n + 1
         If Cells(riga, colonna).Interior.ColorIndex <> -4142 Then
            x = Len(Testo)
            y = Lunghezza
            Inizio = (y - x)
            ReDim Preserve Grass(1, 0 To a)
            Grass(0, a) = Inizio    'Inizio
            Grass(1, a) = x         'Lunghezza
            a = a + 1
         End If
      End If
   Next riga
Next colonna

Cells(1, 7).Value = Join(TestoTotale(), Chr(45))

' verifica che ci sia almeno una cella con sfondo di riempimento
If a > 0 Then
For i = 0 To UBound(Grass, 2)
  With Cells(1, 7).Characters(Start:=Grass(0, i), Length:=Grass(1, i)).Font
      .FontStyle = "Grassetto"
  End With
Next i
End If
End Sub

di skiro (utente non iscritto) data: 26/01/2014 00:15:28
credo che da solo non sarei mai riuscito....
vediamo cosa hai fatto:

Sub grassetto()
Dim riga As Long, colonna As Long
Dim Testo As String, TestoTotale As String
Dim Inizio As Long, GrassI() As Long, GrassL() As Long, i As Long
Dim a As Long, x As Long, y As Long

For riga = 1 To 5
For colonna = 1 To 2
If Cells(riga, colonna) <> "" Then

ok fin qui il codice con due cicli for annidati gira per le celle che a me interessano............
quando in quelle celle c'è qualcosa allora.......

Testo = Cells(riga, colonna)
TestoTotale = TestoTotale & "-" & Testo
Cells(1, 7).Value = TestoTotale

lo concatena inserendo un trattino, tutto come avevo fatto io.....

If Cells(riga, colonna).Interior.ColorIndex <> -4142 Then
x = Len(Cells(riga, colonna))
y = Len(Cells(1, 7))
Inizio = (y - x) + 1

inoltre se è presente uno sfondo......
x=lunghezza del testo appena copiato
y=lunghezza del testo che sono arrivato concatenando i vari testi fin qui concatenati
inizio=punto in cui mi devo posizionare per "grassettare"...... dopo.

ReDim Preserve GrassI(0 To a)
ReDim Preserve GrassL(0 To a)
GrassI(a) = Inizio
GrassL(a) = x
a = a + 1

qua i mieri ricordi di programmazione in C erano oramai troppo arrugginiti.
queste informazioni le hai segnate su array che vengono dichiarati man mano che servono.......

End If
End If
Next colonna
Next riga

For i = 0 To UBound(GrassI)

questo Ubound() onestamente non l'ho ancora capito.....

With Cells(1, 7).Characters(Start:=GrassI(i), Length:=GrassL(i)).Font

qua prendo la cella destinataria mi piazzo dove in precedenza mi ero segnato i punti "cruciali" per la lunghezza necessaria, e trasformo in grassetto.

.FontStyle = "Grassetto"
End With
Next i

funziona alla perfezione.
grazie per la spiegazione delle variabili. Effettivamente la tipologia delle mie variabili non era corretta.
Devo frequentare questo forum se voglio rimasticare un po' di programmazione!!
Saluti a tutti.

End Sub
di skiro (utente non iscritto) data: 26/01/2014 00:18:21
dimenticavo......
la seconda soluzione che mi hai dato.... la studio domani...
saluti

Vuoi Approfondire?