ciao a tutti.
allora, usando il codice sotto riportato ottengo qualcosa che si avvicina moooolto a quello che cerco, a meno:
1) del formato dei file prodotti che è in excel e non word (cambiando l'estensione nel codice, sostituendo xls con doc, i file word prodotti non sono apribili perchè risultano danneggiati
)
2) e della cella di origine dei dati (e qui rispondo a Flash30005). Al momento la tabella inizia in cella A1 ma vorrei abbassarla di qualche riga (A3) per inserire nelle prime righe un'immagine per la formattazione dell'output...ma ahimè non ci sono riuscita completamente, perchè mi perdo la riga di intestazione della tabella nel nuovo file.
Ho ancora qualche dubbio sulla formattazione di output: nel caso in cui produrre un file word sia particolarmente complesso, posso trovare un compromesso con una stampa in excel che poi trasformo in pdf o direttamente in pdf. il dubbio è: il file excel prodotto con il codice sotto scrive partendo dalla cella A1, è possibile farla partire anche in questo caso dalla cella A3? (il resto del layout con immagini/colori etc è già perfetto! )
nel caso invece si produca un pdf (o anche un word), affinchè la tabella (in larghezza) sia contenuta in una stessa pagina, cioè tutte le colonne in una pagina, devo agire sull'area di stampa del foglio excel di origine, giusto?
Function RangePublish3(ByVal mySh As String, ByVal PRan As String, Optional ByVal FName As String = "myBDT.htm") As Variant
'Vedi
viewtopic.php?f=26&t=101351' aggiornamento:
viewtopic.php?f=26&t=101543'
Dim TmpFile As String, myBDT As String, PubFile
If Len(Replace(UCase(Right(FName, 5)), ".XLS", "")) = Len(UCase(Right(FName, 5))) Then FName = FName & ".xls"
TmpFile = "C:\PROVA\" & FName
'Crea file html:
Application.Intersect(Columns(PRan), ActiveSheet.UsedRange).Copy
Workbooks.Add
ActiveSheet.Paste
Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False '*** 1
Application.DisplayAlerts = False '*** 2
ActiveWorkbook.SaveAs Filename:=TmpFile
ActiveWorkbook.Close savechanges:=False
Application.DisplayAlerts = True
'
End Function
Sub mytest()
Dim ListC As String
'
ListC = "K" '<<<1 Una colonna LIBERA in cui sara' creato l' elenco dei nominativi
'
ActiveSheet.Range("$A:$A").AutoFilter Field:=1, Criteria1:="*"
Range(ListC & ":" & ListC).ClearContents
Range("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range(ListC & "1") _
, Unique:=True
For I = 2 To Cells(Rows.Count, ListC).End(xlUp).Row
If Cells(I, ListC) <> "" Then
ActiveSheet.Range("$A:$A").AutoFilter Field:=1, Criteria1:=Cells(I, ListC).Value
Range("A1").Select
xxx = RangePublish3(ActiveSheet.Name, "B:H", Cells(I, ListC).Value) '<<<2
End If
Next I
ActiveSheet.Range("$A:$A").AutoFilter Field:=1, Criteria1:="*"
End Sub
grazie mille!!