Apercu pdf dans userform

[ngexcel]

bonjour
je voudrais modifier la macro de se fichier afin d avoir un aperçu d'un fichier excel au lieu d un pdf
(le fichier est a copier dans le répertoire ou est stocké les fichiers pdf et excel)

merci à tous

 

[job75]

Re : Apercu pdf dans userform

Bonjour ngexcel,

Le WebBrowser ne permet pas d'afficher un aperçu des classeurs Excel.

Il faut créer un fichier PDF pour chacun de ces classeurs.

Cela peut se faire manuellement ou bien à l'ouverture de votre UserForm :

Private Sub UserForm_Initialize()
Dim nf$, a$(), n%
Me.Height = Application.Height
Me.Width = Application.Width
Répertoire = ThisWorkbook.Path 'à adapter
'---liste des classeurs Excel---
nf = Dir(Répertoire & "\*.xls*")
While nf <> ""
  ReDim Preserve a(1, n) 'base 0
  a(0, n) = Répertoire & "\" & nf
  a(1, n) = Répertoire & "\" & Left(nf, InStrRev(nf, ".")) & "pdf"
  n = n + 1
  nf = Dir
Wend
'---création des fichiers PDF---
For n = 0 To UBound(a, 2)
  If a(0, n) <> ThisWorkbook.FullName And Dir(a(1, n)) = "" Then
    Application.ScreenUpdating = False
    With Workbooks.Open(a(0, n))
      .Sheets(1).ExportAsFixedFormat xlTypePDF, a(1, n) '1ère feuille
      .Close False
    End With
    Application.ScreenUpdating = True
  End If
Next
'---Liste des fichiers PDF---
ChoixFichier.Clear
n = 0
nf = Dir(Répertoire & "\*.pdf")
While nf <> ""
  ChoixFichier.AddItem nf
  nf = Dir
  n = n + 1
Wend
nbFichiers = n
End Sub

A+

 

[job75]

Re : Apercu pdf dans userform

Re,

A la réflexion il faut conserver l'extension des Classeurs Excel en créant le fichier PDF :

- on saura ainsi qu'il s'agit de classeurs Excel convertis

- on peut créer des fichiers PDF pour chaque classeur du même nom et d'extension différente

Private Sub UserForm_Initialize()
Dim nf$, a$(), n%
Me.Height = Application.Height
Me.Width = Application.Width
Répertoire = ThisWorkbook.Path 'à adapter"
'---liste des classeurs Excel---
nf = Dir(Répertoire & "\*.xls*")
While nf <> ""
  If Not nf Like "*.pdf" Then
    ReDim Preserve a(n) 'base 0
    a(n) = Répertoire & "\" & nf
    n = n + 1
  End If
  nf = Dir
Wend
'---création des fichiers PDF---
If n Then
  For n = 0 To UBound(a)
    nf = Mid(a(n), InStrRev(a(n), "\") + 1)
    If nf <> ThisWorkbook.Name And Dir(a(n) & ".pdf") = "" Then
      Application.ScreenUpdating = False
      With Workbooks.Open(a(n))
        .Sheets(1).ExportAsFixedFormat xlTypePDF, a(n) & ".pdf" '1ère feuille
        .Close False
      End With
      Application.ScreenUpdating = True
    End If
  Next
End If
'---Liste des fichiers PDF---
ChoixFichier.Clear
n = 0
nf = Dir(Répertoire & "\*.pdf")
While nf <> ""
  ChoixFichier.AddItem nf
  nf = Dir
  n = n + 1
Wend
nbFichiers = n
End Sub

Edit : j'ai aussi modifié pour le cas où Répertoire est différent de ThisWorkbook.Path.

A+

 

[job75]

Re : Apercu pdf dans userform

Re,

Si les classeurs Excel sont susceptibles d'être modifiés, on peut recréer à chaque ouverture tous les fichiers PDF en écrasant les anciens, mais bien sûr cela prendra du temps, trop peut-être :

Private Sub UserForm_Initialize()
Dim nf$, a$(), n%
Me.Height = Application.Height
Me.Width = Application.Width
Répertoire = ThisWorkbook.Path 'à adapter"
'---liste des classeurs Excel---
nf = Dir(Répertoire & "\*.xls*")
While nf <> ""
  If Not nf Like "*.pdf" Then
    ReDim Preserve a(n) 'base 0
    a(n) = Répertoire & "\" & nf
    n = n + 1
  End If
  nf = Dir
Wend
'---création des fichiers PDF---
If n Then
  Application.ScreenUpdating = False
  For n = 0 To UBound(a)
    nf = Mid(a(n), InStrRev(a(n), "\") + 1)
    If nf <> ThisWorkbook.Name Then
      With Workbooks.Open(a(n))
        .Sheets(1).ExportAsFixedFormat xlTypePDF, a(n) & ".pdf" '1ère feuille
        .Close False
      End With
    End If
  Next
  Application.ScreenUpdating = True
End If
'---Liste des fichiers PDF---
ChoixFichier.Clear
n = 0
nf = Dir(Répertoire & "\*.pdf")
While nf <> ""
  ChoixFichier.AddItem nf
  nf = Dir
  n = n + 1
Wend
nbFichiers = n
End Sub

Chez moi sur Excel 2013 Application.DisplayAlerts = False n'est pas nécessaire.

Bonne fin de soirée.

 

[job75]

Re : Apercu pdf dans userform

Bonjour ngexcel, le forum,

Avec cette solution on repère les classeurs Excel non listés ou modifiés, et l'on n'ouvre que ceux-là :

Private Sub UserForm_Initialize()
Dim F As Worksheet, nf$, a$(), n&, dat As Variant, ouvre As Boolean
Me.Height = Application.Height
Me.Width = Application.Width
Set F = Feuil2 'CodeName de la feuille de mémorisation, à adapter
Répertoire = ThisWorkbook.Path 'à adapter"
'---liste des classeurs Excel---
nf = Dir(Répertoire & "\*.xls*")
While nf <> ""
  If Not nf Like "*.pdf" Then
    ReDim Preserve a(1, n) 'base 0
    a(0, n) = Répertoire & "\" & nf
    a(1, n) = FileDateTime(a(0, n))
    n = n + 1
  End If
  nf = Dir
Wend
'---création des fichiers PDF---
If n Then
  For n = 0 To UBound(a, 2)
    nf = Mid(a(0, n), InStrRev(a(0, n), "\") + 1)
    If nf <> ThisWorkbook.Name Then
      dat = Application.VLookup(a(0, n), F.[A:B], 2, 0)
      ouvre = False
      If IsError(dat) Then ouvre = True Else If dat <> a(1, n) Then ouvre = True
      If ouvre Then
        Application.ScreenUpdating = False
        With Workbooks.Open(a(0, n))
          .Sheets(1).ExportAsFixedFormat xlTypePDF, a(0, n) & ".pdf" '1ère feuille
          .Close False
        End With
        Application.ScreenUpdating = True
      End If
    End If
  Next
End If
'---mémorisation des classeurs Excel---
If n Then F.[A2].Resize(n, 2) = Application.Transpose(a)
F.[A2].Offset(n).Resize(Rows.Count - n - 1, 2).Delete xlUp
F.Columns("A:B").AutoFit
'---Liste des fichiers PDF---
ChoixFichier.Clear
n = 0
nf = Dir(Répertoire & "\*.pdf")
While nf <> ""
  ChoixFichier.AddItem nf
  nf = Dir
  n = n + 1
Wend
nbFichiers = n
End Sub

Bonne journée.

 

[ngexcel]

Re : Apercu pdf dans userform

bonjour job75
pouvez vous me mettre le fichier modifier cela me parlera plus
encore merci je vous tiens au courant

 

[job75]

Re : Apercu pdf dans userform

Re,

Une solution moins facile à comprendre avec le Dictionary mais bien plus rapide s'il y a beaucoup de classeurs Excel :

Private Sub UserForm_Initialize()
Dim F As Worksheet, rep$, d As Object, nf$, a$(), n&, t, i&, x$, b
Me.Height = Application.Height
Me.Width = Application.Width
Set F = Feuil2 'CodeName de la feuille de mémorisation, à adapter
Répertoire = ThisWorkbook.Path 'à adapter
rep = Répertoire & "\"
'---liste des classeurs Excel---
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
nf = Dir(rep & "*.xls*")
While nf <> ""
  If Not nf Like "*.pdf" And Not nf = ThisWorkbook.Name Then
    ReDim Preserve a(1, n) 'base 0
    a(0, n) = rep & nf
    a(1, n) = FileDateTime(a(0, n))
    d(a(0, n) & Chr(1) & a(1, n)) = ""
    n = n + 1
  End If
  nf = Dir
Wend
'---repérage des classeurs modifiés---
t = F.[A2].CurrentRegion.Resize(, 2)
For i = 1 To UBound(t)
  x = t(i, 1) & Chr(1) & t(i, 2)
  If d.exists(x) Then d.Remove x
Next
'---création des fichiers PDF---
If d.Count Then
  b = d.keys
  Application.ScreenUpdating = False
  For i = 0 To UBound(b)
    x = Split(b(i), Chr(1))(0)
    With Workbooks.Open(x)
      .Sheets(1).ExportAsFixedFormat xlTypePDF, x & ".pdf" '1ère feuille
      .Close False
    End With
  Next
  Application.ScreenUpdating = True
End If
'---mémorisation des classeurs Excel---
If n Then F.[A2].Resize(n, 2) = Application.Transpose(a)
F.[A2].Offset(n).Resize(Rows.Count - n - 1, 2).Delete xlUp
F.Columns("A:B").AutoFit
'---Liste des fichiers PDF---
ChoixFichier.Clear
n = 0
nf = Dir(rep & "*.pdf")
While nf <> ""
  ChoixFichier.AddItem nf
  nf = Dir
  n = n + 1
Wend
nbFichiers = n
End Sub

Fichier joint puisque vous le voulez (?)

Edit : j'ai ajouté la variable rep pour gagner encore du temps.

A+

 

[ngexcel]

Re : Apercu pdf dans userform

re bonjour
merci juste
les fichiers excel sont bien convertis en pdf et j ai bien un aperçu
mais je cherche un bouton pour ouvrir l aperçu pas en pdf mais le fichier excel comme ca j ai un bouton pour l aperçu (pour l utilisateur)
l autre bouton (pour administrateur) et pourquoi pas avec un mot de passe

 

[ngexcel]

Re : Apercu pdf dans userform

bonjour
une copie d 'écran du projet plus précis
merci

 

[job75]

Re : Apercu pdf dans userform

Re, salut tatiak,

Voir le fichier joint, l'USF principal s'ouvre en non modal.

A+

 

[ngexcel]

Re : Apercu pdf dans userform

Bonsoir c 'est exactement ça (Form_FichiersListe(1).xlsm) j ai juste une dernière chose quand je choisi dans la liste un fichier je clic sur ouvrir avec excel peux ton avoir le fichier en premier plan
encore merci c'est vraiment super bonne soirée

 

[job75]

Re : Apercu pdf dans userform

Bonjour ngexcel, le forum,

peux ton avoir le fichier en premier plan

Vous voulez dire réactiver le fichier Excel une fois qu'il a été ouvert ?

En effet ceci n'oblige pas à retaper le mot de passe à chaque fois :

Private Sub Image3_Click() 'logo Excel
Dim x$
If Not FichierChoisi Like "*?.pdf" Then Exit Sub
x = Left(FichierChoisi, Len(FichierChoisi) - 4)
On Error Resume Next
If IsError(Workbooks(x)) Then
  UserForm1.Show
  If mdp Then Workbooks.Open Répertoire & "\" & x
Else
  Workbooks(x).Activate
End If
End Sub

Par ailleurs j'ai regardé la macro b_dossier_Click(), elle appelle UserForm_Initialize.

Donc dans UserForm_Initialize il faut compléter :

If Répertoire = "" Then Répertoire = ThisWorkbook.Path 'à adapter

Et dans ChoixFichier_Change :

If IsNull(ChoixFichier) Then Exit Sub

Fichier (2)

Bonne journée.

Edit : suite à ce fil :

https://www.excel-downloads.com/threads/ouvrir-une-feuille-excel-dessu-un-userform.20006109/

j'ai mis dans ThisWorkbook :

Private Sub Workbook_Activate()
afficheform
End Sub

Private Sub Workbook_Deactivate()
F_ListeFichiersRep.Hide
End Sub

 

[ngexcel]

Re : Apercu pdf dans userform

Bonjour
Merci pour le complément d info Ç est bon

 

[job75]

Re : Apercu pdf dans userform

Re,

Je viens de corriger le post #13.

J'ai modifié la macro avec Répertoire & "\" & x

De plus dans Image2_Click() j'ai ajouté If Len(FichierChoisi) < 5 Then Exit Sub

A+

 

[ngexcel]

Re : Apercu pdf dans userform

Ok je test en rentrant merci