Word: Come "riconoscere" le pagine che hanno testi colorati?

[Flash30005]

Posto questo quesito perché penso possa essere utile a molti utenti nel caso si trovasse una soluzione valida.
Come da titolo, è possibile ricavarsi, tramite macro, le pagine (intendo come numero pagina) di un documento word nelle quali c'è almeno una frase a colori o immagine rispetto a quelle solo in bianco e nero?

Il problema nasce da una situazione reale:
avendo due stampanti una a colori a getto di inchiostro e l'altra laser in bianco e nero.
(al fine di velocizzare la stampa e ottimizzare sia il tempo sia la spesa dell'operazione)
devo suddividere le pagine di un documento word di circa 200 pagine o più
cerco, quindi, un codice vba (sia in Excel o Word) che possa assolvere a questo quesito.

Chi ha qualche soluzione?

Ciao

[PcBase]

Ciao

Chi ha qualche soluzione?

Un link http://pubs.logicalexpressions.com/Pub0 ... asp?ID=116

[Flash30005]

Grazie PcBase

Mi sembra di capire che quella macro converte una pagina a colori in B/n prima di inviarla alla stampa (magari su stampante a colori per stamparla in bianco e nero)
a me invece interessa conoscere i numeri di pagina delle pagine a colori per inviarli alla stampante a colori e le altre pagine per inviarle alla stampante in Bianco nero.

ciao

[PcBase]

Ciao

Insisto a togliere i colori
Puoi usare un ciclo per contare i colori presenti

Codice: Seleziona tutto

Sub DeleteNonBlack()
   Dim Wrd As Range
   Dim wdcolor As String
   Const HexadecimalPrefix As String = "color:#"
   Const HexadecimalSuffix As String = ";"

   For Each Wrd In ActiveDocument.Words
    If Wrd.Font.Color <> wdColorBlack And Wrd.Font.Color <> wdColorAutomatic Then
    wdcolor = Hex(Wrd.Font.Color)
    Wrd = "<span style=""" & HexadecimalPrefix & wdcolor & HexadecimalSuffix & """>" & Wrd & "</span>"
    Wrd.Font.Color = wdColorAutomatic
    End If
    Next Wrd
   
End Sub

Ancora per info
http://word.tips.net/T001573_Selecting_ ... tures.html

[Flash30005]

Non è proprio quello che cercavo inoltre scrive nel documento tanti codici strani (<span> etc)

Avrei trovato e modificato una macro che dovrebbe essere un buon inizio
alla fine ho l'elenco delle pagine a colori separate da una virgola (proprio come lo vuole il box di una stampante prima della stampa)
la macro per i caratteri è questa

Codice: Seleziona tutto

Sub Parole3()


 Dim parola As Range
 Dim strParola As String
 Dim voceIndice As String
 Dim voceIndiceTrovata As Boolean
 Dim numeroPagina As String
 Dim MnumPag As Integer
 Dim NpCol As String
 
 
 For Each parola In ThisDocument.Words

 If parola.Font.ColorIndex > 1 Then
strParola = CStr(parola)
strParola = Replace(strParola, Chr(13), "")
 If Trim(strParola) <> "" Then
 If voceIndiceTrovata = False Then
 parola.Select
 numeroPagina = Selection.Information(wdActiveEndPageNumber)
  If MnumPag <> numeroPagina Then
  MsgBox numeroPagina
  If NpCol = "" Then
  NpCol = numeroPagina
  Else
  NpCol = NpCol & "," & numeroPagina
  End If
  End If
  MnumPag = numeroPagina
 End If
 End If
 voceIndiceTrovata = True
 Else

 If voceIndiceTrovata = True And Trim(voceIndice) <> "" Then
' MsgBox numeroPagina
 End If
 voceIndice = ""
 voceIndiceTrovata = False

 End If

 Next parola
MsgBox NpCol
End Sub

Ora devo trovare le pagine che contengono le immagini (essendo quest'ultime a colori)

ciao

[Flash30005]

Il programma, grazie alla disponibilità di Anthony che si è prestato a risolvere diversi punti, è funzionante.
Permette di salvare, in un file testo (nella stessa directory del file word), i numeri pagina delle pagine che contengono testo e note a colori o immagini e, in una seconda riga tutte le pagine in bianco e nero.
A questo punto è sufficiente copiare la riga dei numeri pagina e incollarli nell'apposito box di stampa.
E' stato, inoltre, implementato il codice (commentato a fine macro) che permette di stampare direttamente con una o l'altra stampante ma spiegherò alla fine del post come fare.

Codice: Seleziona tutto

Option Base 1
Sub PagineAColoriParagrafo()
msg = " Si sta per avviare la ricerca di fogli a colori e b/n " & vbCrLf
msg = msg & " sul documento " & ActiveDocument.Name & vbCrLf
msg = msg & " il file sara' salvato all'inizio e poi Chiuso " & vbCrLf
msg = msg & " per confermare premi SI, oppure NO"
scelta = MsgBox(Prompt:=msg, Buttons:=vbYesNo)
If scelta = 7 Then Exit Sub
'Ini = Timer
 ActiveDocument.Save
 Dim Parola, PParola
 Dim strParola As String
 Dim voceIndice As String
 Dim voceIndiceTrovata As Boolean
 Dim numeroPagina As String
 Dim MnumPag As Integer, JJ As Long
 Dim NpCol As String, NpBN As String
 Dim PagImm As String
 Dim InS
 Dim VettC(1000) As Integer
 Perc = ActiveDocument.Path & "/"
 NumPag = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
 
 Application.ScreenUpdating = False
 'Controlla nelText
 For Each Parola In ActiveDocument.Paragraphs '.Words
    JJ = JJ + 1
    Parola.Range.Select
    If Selection.Font.ColorIndex > 1 And VettC(Selection.Information(wdActiveEndPageNumber)) = 0 Then
        strParola = CStr(Parola)
        strParola = Replace(strParola, Chr(13), "")
        If Trim(strParola) <> "" Then
            wUnits = Selection.Move(Unit:=wdCharacter, Count:=1)
            For Each PParola In ActiveDocument.Paragraphs(JJ).Range.Words
                PParola.Select
                numeroPagina = Selection.Information(wdActiveEndPageNumber)
                If PParola.Font.ColorIndex > 1 Then VettC(numeroPagina) = numeroPagina
            Next PParola
        End If
    End If
    DoEvents
 Next Parola

'Controlla nelle footnotes:
JJ = 0
If ActiveDocument.Footnotes.Count > 0 Then
For Each Parola In ActiveDocument.StoryRanges(wdFootnotesStory).Paragraphs '.Words
JJ = JJ + 1
 Parola.Range.Select
    If Selection.Font.ColorIndex > 1 And VettC(Selection.Information(wdActiveEndPageNumber)) = 0 Then
        strParola = CStr(Parola)
        strParola = Replace(strParola, Chr(13), "")
        If Trim(strParola) <> "" Then
            For Each PParola In ActiveDocument.StoryRanges(wdFootnotesStory).Paragraphs(JJ).Range.Words
                PParola.Select
                numeroPagina = Selection.Information(wdActiveEndPageNumber)
                If Selection.Font.ColorIndex > 1 Then VettC(numeroPagina) = numeroPagina
            Next PParola
        End If
    End If
    DoEvents
Next Parola
End If

'Controlla Shapes 6 InLineShapes
For Each InS In ActiveDocument.InlineShapes
    InS.Select
    numeroPagina = Selection.Information(wdActiveEndPageNumber)
    VettC(numeroPagina) = numeroPagina
Next InS
'
For Each InS In ActiveDocument.Shapes
    InS.Select
    numeroPagina = Selection.Information(wdActiveEndPageNumber)
    VettC(numeroPagina) = numeroPagina
Next InS

NumPag = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
 For PCol = 1 To NumPag
    If VettC(PCol) <> 0 Then
        NpCol = NpCol & "," & VettC(PCol)
    Else
        NpBN = NpBN & "," & PCol
    End If
 Next PCol
 NpCol = Right(NpCol, Len(NpCol) - 1)
 NpBN = Right(NpBN, Len(NpBN) - 1)
 Application.ScreenUpdating = True
 
Open Perc & "PagStampa.txt" For Output As #1
Print #1, "Col - " & NpCol
Print #1, "B/n - " & NpBN
Close #1

'Stampa B/n stampante default
'Application.PrintOut FileName:=Perc & ActiveDocument.Name, Pages:=NpBN, Range:=wdPrintRangeOfPages

'Stampa Colore
'StDef = Shell("C:\PrintCol.bat") ' imposta la stampante a colori come default
'Application.PrintOut FileName:=Perc & ActiveDocument.Name, Pages:=NpCol, Range:=wdPrintRangeOfPages
'StDef = Shell("C:\PrintDefault.bat") ' reimposta la stamapnte B/n come default

'Fine = Timer - Ini
'MsgBox Fine
ActiveDocument.Close savechanges:=False
End Sub

Per stampare automaticamente con due stampanti diverse ho optato per la soluzione che rende default prima una e poi l'altra stampante utilizzando due file .bat da inserire nella root di C:\
il contenuto del file della stampante default
può essere questo (ognuno dovrà inserire il nome della propria stampante)

Codice: Seleziona tutto

RUNDLL32 PRINTUI.DLL,PrintUIEntry /y /n "HP LaserJet xxxxxxxxxxx"

Sostituire il nome stampante tra le virgolette e nominare il file come: PrintDefault.bat
Per la stampante a colori
il codice è identico ma avrà il nome della stampante a colori all'interno degli apici
il file dovrà avere il nome: PrintCol.bat.
Questi nomi sono necessari in quanto richiamati dalla macro.
Nella macro dovranno essere tolti i commenti nelle ultime righe codice riguardante la stampa

Sono soddisfatto per quanto realizzato ma il progetto può sicuramente essere migliorato.

ciao

EDIT ore 15:30 - aggiunta "Option base 1" in testa al modulo