Auteur, proprietes, ...etc

[SHINTRA]

Hello le Forum,

J ai une question SVP,
Je cherche si il existe des fonctions VB qui me permettreait d'alimenter grace a des cellules contenue dans une feuilles excel les renseignements figurants dans fichiers/Propriétés/Auteurs, commentaires, ...etc


Merci d'avance.

Shintra

 

[MichelXld]

bonjour Shintra


si tu veux modifier une propriété du classeur ouvert

par exemple pour le champ 'auteur'

ThisWorkbook.BuiltinDocumentProperties('author').Value = 'yyyyy'



si tu veux connaitre les noms et les valeurs des propriétées du classeur

Sub infosClasseurBuiltinDocumentProperties()
Dim Valeur As DocumentProperty
Dim R As Byte
On Error Resume Next
R = 1
For Each Valeur In ActiveWorkbook.BuiltinDocumentProperties
Cells(R, 1) = Valeur.Name
Cells(R, 2) = Valeur.Value
R = R + 1
Next
End Sub


pour modifier ou lire les propriétés d'un classeur fermé ( voir le message du 15/05/2005 11:14 )

Lien supprimé



bonne soiree
MichelXld

 

[SHINTRA]

Merci beaucoup michel

Ton post est tres interressant,
je suis en train de lire le fil lien, car se sont plus les modification des proprietes : titre, sujet , auteur, mot cle, commentaires, qui m interresse particulierement.

Je souhaiterais renseignemer ces champs automatique a partir des donnees du classeur pour une meilleur lisibilité des fichiers XLS dans un repertoire windows

je finis de lire le fil , si besoin je reoste une question
( j ai souvent des question ? ) dsl


Merci

Shintra.

 

[SHINTRA]

Michel

Re help ?
voici c a koi je desire arrivée mais sa marche pas pkoi ?

Option Explicit

Sub modifierProprietesfbo()
'necessite d'activer la reference DSO OleDocument Properties Reader 2.0
'http://support.microsoft.com/default.aspx?scid=kb;EN-US;Q224351

'variable'
Dim i As Integer
Dim DSO As DSOFile.OleDocumentProperties
Dim appli As Workbook
Dim count As Integer
Dim x, a, b, c, d

'-----------------------------parti ouvertures consolidation multifichiers  ------------------------------'
Set appli = ActiveWorkbook
With Application.FileSearch
        .NewSearch
        .LookIn = appli.Path
        .SearchSubFolders = True
        .FileType = msoFileTypeExcelWorkbooks
        .Execute
        count = 0
        For i = 1 To .FoundFiles.count
'-----------------------------parti copie des informations necessaires  ------------------------------'
         If .FoundFiles(i) <> appli.FullName Then
            Set x = Workbooks.Open(.FoundFiles(i), True, , , , , , , , , , , False)
            Set a = Range('a1').Value
            Set b = Range('b1').Value
            Set c = Range('c1').Value
            x.Activate
            x.Close SaveChanges:=False
'-----------------------------parti modif des proprietes ------------------------------'
            Set DSO = New DSOFile.OleDocumentProperties
            'le fichier doit etre fermé !
            DSO.Open sfilename:=x
            DSO.SummaryProperties.Title = a
            DSO.SummaryProperties.Subject = b
            DSO.SummaryProperties.Keywords = c
            DSO.SummaryProperties.Comments = d
            DSO.Save
             DSO.Close
        End If
       Next i
    End With
End Sub



merci

 

[MichelXld]

rebonsoir Shintra

si tu dois ouvrir les classeurs pour recuperer les données des cellules A1 à D1 , pourquoi ne modifies tu pas en meme temps les propriétés du classseur

par exemple :


Sub modifierProprietesV02()
Dim i As Integer
Dim Wb As Workbook
Dim x As Workbook

Application.ScreenUpdating = False

Set Wb = ThisWorkbook
With Application.FileSearch
.NewSearch
.LookIn = Wb.Path
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
.Execute

For i = 1 To .FoundFiles.count
If .FoundFiles(i) <> Wb.FullName Then
Set x = Workbooks.Open(.FoundFiles(i), True, , , , , , , , , , , False)

With x
.BuiltinDocumentProperties('Title').Value = Range('A1')
.BuiltinDocumentProperties('Subject').Value = Range('B1')
.BuiltinDocumentProperties('Keywords').Value = Range('C1')
.BuiltinDocumentProperties('Comments').Value = Range('D1')
End With

x.Close SaveChanges:=True
End If
Next i
End With

Application.ScreenUpdating = True
End Sub


bonne soiree
MichelXld

 

[SHINTRA]

Merci Michel c PARFAIT
Une fois de plus du trouve la solution

Encore Merci

@+