Créer nouvelle feuille et incorporé données listview

Bonjour,

Je fais appel à vous car je bloque depuis quelques jours sans arriver à comprendre pq ...

J'avais l'habitude d'utiliser des listbox, mais étant donné que les listview sont plus performantes et permettent plus de choses j'ai décider de me lancer dans le sujet.

J'ai donc réussis (avec l'aide d'internet), sans forcément tout comprendre (la est le pb), à extraire une listview pour créer une news sheet et générer celle ci en pdf puis la suppr.

Ma ListView réussis comporte deux colonnes et un nombre x de ligne et celle ci fonctionne parfaitement :

   If ListView1.ListItems.Count = 0 Then
    MsgBox ("Aucune données à générer ...")
    Exit Sub
    Else
    End If

MsgBox ("Merci de choisir le dossier dans lequel vous voulez que le PDF soit généré !")

On Error GoTo selectionobligatoire
Dim finput As FileDialog
Set finput = Application.FileDialog(msoFileDialogFolderPicker)
finput.Show

With finput
Sheets("Paramètre").Cells(1, 4) = .SelectedItems(1) 'Enregistre le chemin du dossier dans lequel doit ce trouver le fichier généré en feuille "paramètre"
End With

Application.ScreenUpdating = False

Sheets.Add.Name = "Temp"

Dim k
Dim i
Dim j

With Me.ListView1
   For k = 1 To .ColumnHeaders.Count
       Sheets("Temp").Cells(1, k).ColumnHeaders.item(k).Text
       Sheets("Temp").Cells(1, k).Font.Bold = True
       Sheets("Temp").Cells(1, k).Font.Size = 12
       Sheets("Temp").Cells(1, k).Interior.Color = vbBlue
   Next k

Sheets("Temp").Select

   For i = 2 To .ListItems.Count + 1
       Sheets("Temp").Cells(i, 1) = .ListItems(i - 1).Text

       For j = 1 To .ListItems(i - 1).ListSubItems.Count
           Sheets("Temp").Cells(i, j + 1) = .ListItems(i - 1).SubItems(j)
       Next j
   Next i
End With

Sheets("Temp").Select
    Cells.Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

Dim sRep As String                  ' Répertoire de sauvegarde
Dim sFilename As String             ' Nom du fichier
Dim reponse As String
Dim reponse2 As Long

reponse = InputBox("Donner un nom à votre fichier")

If reponse = "" Then
MsgBox ("L'enregistrement à échoué")
Application.DisplayAlerts = False
Sheets("Temp").Delete
Application.DisplayAlerts = True
Exit Sub
Else
End If

sRep = Sheets("Paramètre").Range("D1").Value                     ' Répertoire de sauvegarde (si non spécifié, répertoire actif par défaut)
sFilename = reponse      ' Nom du fichier

Sheets("Temp").PageSetup.Orientation = xlLandscape
Sheets("Temp").PageSetup.Zoom = False
Sheets("Temp").PageSetup.FitToPagesTall = 1
Sheets("Temp").PageSetup.FitToPagesWide = 1

Sheets("Temp").Range("A1:" & Cells(i, j).Address).ExportAsFixedFormat _
                     Type:=xlTypePDF, _
                     Filename:=sRep & "\" & sFilename, _
                     Quality:=xlQualityStandard, _
                     IncludeDocProperties:=True, _
                     IgnorePrintAreas:=False, _
                     OpenAfterPublish:=False

Sheets("Paramètre").Range("D2").Value = sRep & "\" & reponse & ".pdf"

Application.DisplayAlerts = False
Sheets("Temp").Delete
Application.DisplayAlerts = True

reponse2 = MsgBox("La base de donnée à bien été enregistrer, souhaitez vous l'ouvrir ?", _
vbYesNo + vbQuestion + vbDefaultButton1, _
"")

If reponse2 = vbYes Then

Call OuvrirUnFichierPDF 'ouvre le fichier pdf dont le chemin ce situe en cellule D2 de la feuille paramètre

Else
End If

Application.ScreenUpdating = True

Exit Sub

selectionobligatoire: 'Si l'utilisateur quitte avant d'avoir choisit le fichier
MsgBox ("Vous n'avez pas choisit de dossier pour enregistrer votre fichier, l'enregistrement à échoué !")
Exit Sub

End Sub

Seulement je n'arrive pas à reproduire cette macro avec une listview comportant 14 colonnes ...

Une erreur apparaît : "Erreur d’exécution 438 ; Propriété ou méthode non gérée par cet objet"

Et la ligne pointé par le débogueur est la suivante :

Sheets("Temp").Cells(1, k).ColumnHeaders.item (k).text

Quelqu'un aurait une idée ?

Bonjour

pour faire une listview il faut au moins un fichier

car j'ais pas une boule de cristal

A+

Maurice

Voila

Bonsoir

voila une listview sur la base Data_User

pour le nombre de colonne voir dans Activate

A+

Maurice

Bonsoir, je vois bien la listview que vous avez mis dans l'usf1 mais j'en avais déjà une dans tableau de bord

La listview est déjà alimenté, le problème est d'extraire les données

Bonjour

voila un essai d'édition pdf

et évite de crée a chaque fois la feuille temp

comme je voie que tu maitrise bien ses ma dernière réponse

A+

Maurice

Bonjour Maurice,

C'est noté je devrais réussir à l'adapter à mon cas !

Merci beaucoup en tout cas

A+

Re,

Je me permets juste une dernière petite question.

Dans le fichier que tu m'as renvoyé, pourquoi est ce que si je copie le code de ton bouton et que je le mets dans le miens situé sur l'userform TBLB, j'ai le message d'erreur suivant : "invalid property value" qui pointe sur :

Cells(i, j + 1) = .ListItems(i - 1).SubItems(j)

Ma listview est alimenté différemment ok mais j'arrive pas à piger ...

Cette ligne à un rapport avec le code initialize de l'usf ? Ou avec ton code dans le module ? Ou c'est du à la façon d'alimenter la listview ?

bonjour

donne au moins ton modèle que tu a modifier

A+

Maurice

le modèle est celui présent dans l'userform TBLB que j'ai déjà envoyé, il s'alimente lorsque l'on remplis la textbox3 (correspondant à l'année)

Bonjour

je ne travail pas sur ta listview car je ne la comprend pas

a oui et il manque des mois

donc j'ais fait des modifes sur ma listview

a toi de voir

A+

Maurice

Bonjour à tous

si j'ai compris

With Me.ListView1
   For k = 1 To .ColumnHeaders.Count
       Sheets("Temp").Cells(1, k)       =         .ColumnHeaders.Item(k).Text        il manque le =
       Sheets("Temp").Cells(1, k).Font.Bold = True
       Sheets("Temp").Cells(1, k).Font.Size = 12
       Sheets("Temp").Cells(1, k).Interior.Color = vbBlue
   Next k

Sheets("Temp").Select

   For i = 2 To .ListItems.Count + 1
       Sheets("Temp").Cells(i, 1) = .ListItems(i - 1).Text

       For j = 1 To .ListItems(i - 1).ListSubItems.Count - 1                            il manque -1
           Sheets("Temp").Cells(i, j + 1) = .ListItems(i - 1).SubItems(j)
       Next j
   Next i
End With

Bonjour Bob,

C'était exactement ça ! Merci beaucoup