Récupération propriété title - .xla ?

[starz]

Bonjour,
Je dois mettre à jour le titre d'une centaine de document excel.
Ce titre est présent dans la cellule i4 de la feuil1.

Pourriez vous m'aider sans ouvrir chaque document (si possible j'espère) à concevoir une macro (xla peut être) ou autre, afin de parvenir à mes modifications le plus rapidement et le plus simplement possible.

merci de votre aide

voici un bout de macro que j'avais récupérer ici mais ça m'oblige à l'intégrer à chaque document :

Private Sub Workbook_Before_Close(Cancel As Boolean)
ThisWorkbook.BuiltinDocumentProperties("Title").Value = Sheets("Feuil1").Range("i4").Value 
End Sub

 

[JNP]

Re : Récupération propriété title - .xla ?

Re 🙂,

Dans ce cas ni ton code ni le mien ne font le job 😉

Mais celui-ci oui 😉 (aie la crampe )

Crampes aux chevilles, ou après les 100 InputBox à remplir 😀.
Non, je persiste. Je pense que (exemple, les devoirs de ses 100 élèves rendus sous Excel, mettez votre nom en case "I4") les fichiers sont déjà renseignés. Mais notre ami impatient va bien nous départager 😛.
A bientôt et XLDente journée 😎

 

[starz]

Re : Récupération propriété title - .xla ?

Merci,
JNP est le vainqueur pour son premier code.
En effet l'exemple sur les élèves est correct, le nom était déjà présent dans la case.

Encore merci à vous tous .

Bonne soirée

EDIT : en faisant la manip j'ai remarqué un ptit bug parmis toutes les copies des élèves.
Certain ont mis leur nom dans la case H4.
Si je modifie la macro ça fonctionne mais ça efface les fichiers avec le titre en I4.

Vous avez une solution ?

 

[vbacrumble]

Re : Récupération propriété title - .xla ?

Re

C'est donc JNP qui avait raison 😉

Pourquoi avoir mis et juste après retiré ton fichier de 1996 ? 😉

Normalement cela doit fonctionner

Sub renommetitre3()
Dim WB As Workbook, Chemin$, nfich$, Titre$
Chemin = "C:\temp\" 'changer le nom du dossier selon vos besoins
nfich = Dir(Chemin & "*.xls")
Do While nfich <> ""
    Workbooks.Open Filename:=Chemin & nfich
    Titre = Feuil1.Range("I4").Text
    Workbooks(nfich).BuiltinDocumentProperties("Title").Value = Titre
    Workbooks(nfich).Close True
nfich = Dir
Loop
End Sub

 

[starz]

Re : Récupération propriété title - .xla ?

nos réponses ont du se croisé 18h15 - 18h17 , regarde le post du dessus.

J'ai enlevé le fichier car en faite vous n'en avez pas besoin 😛

par contre il reste un loup 😕

 

[JNP]

Re : Récupération propriété title - .xla ?

Re 🙂,
Ayons le triomphe modeste (sonnez trompettes 😛). Remplace

Titre = Sheets(1).Range("I4").Text

par

If Sheets(1).Range("I4").Text <> "" Then
    Titre = Sheets(1).Range("I4").Text
Else
    Titre = Sheets(1).Range("H4").Text
End

Bonne journée 😎

 

[vbacrumble]

Re : Récupération propriété title - .xla ?

Bonjour


Histoire de saluer JNP 😉 (et parce j'aime l'IIF)

Je remplacerai par

 Titre = IIF(Sheets(1).Range("I4").Text <> "",Sheets(1).Range("I4").Text,Sheets(1).Range("H4").Text)

En version non recommandée par la VBA Academy

Sub test()
Dim Titre$
With Sheets(1).Range("I4"): Titre = IIf(.Text <> "", .Text, .Offset(, -1).Text): End With
MsgBox Titre
End Sub

en version classique

Sub test()
Dim Titre$
With Sheets(1).Range("I4")
Titre = IIf(.Text <> "", .Text, .Offset(, -1).Text)
End With
MsgBox Titre
End Sub

 

[vbacrumble]

Re : Récupération propriété title - .xla ?

Re

Histoire d'honorer le JNP triomphant 😉

Sub testJNP()
With Sheets(1).Range("I4")
    If .Text <> "" Then
        titre = .Text
    Else
        titre = .Offset(, -1).Text
    End If
End With
End Sub

PS: JNP , il manque le If à ton End (dans ton message de 09h12)

 

[JNP]

Re : Récupération propriété title - .xla ?

Re 🙂,
Effectivement VBACrumble, il manque mon cypré après mon End 😛. Mea Culpa 😉. C'est la rançon de la gloire, j'ai touché mon End à crédit 😀.
Bonne soirée 😎

 

[starz]

Re : Récupération propriété title - .xla ?

Merci à vous tous :

POur conclure j'utilise ce code car les autres j'ai pas tous compris :

Private Sub CommandButton1_Click()
Dim WB As Workbook, Chemin$, nfich$, Titre$
Chemin = "C:\temp\" 'changer le nom du dossier selon vos besoins
nfich = Dir(Chemin & "*.xls")
Do While nfich <> ""
    Workbooks.Open Filename:=Chemin & nfich
    If Sheets(1).Range("I4").Text <> "" Then
    Titre = Sheets(1).Range("I4").Text
Else
    Titre = Sheets(1).Range("H4").Text
End If
    Workbooks(nfich).BuiltinDocumentProperties("Title").Value = Titre
    Workbooks(nfich).Close True
nfich = Dir
Loop
End Sub

par contre pour le chemin si le fichier macro est dans le même dossier ç ne fonctionne pas, voici le code :

Private Sub CommandButton2_Click()
Dim WB As Workbook, Chemin$, nfich$, Titre$
Chemin = ThisWorkbook.Path & "\"  'changer le nom du dossier selon vos besoins
nfich = Dir(Chemin & "*.xls")
Do While nfich <> ""
    Workbooks.Open Filename:=Chemin & nfich
    If Sheets(1).Range("I4").Text <> "" Then
    Titre = Sheets(1).Range("I4").Text
Else
    Titre = Sheets(1).Range("H4").Text
End If
    Workbooks(nfich).BuiltinDocumentProperties("Title").Value = Titre
    Workbooks(nfich).Close True
nfich = Dir
Loop
End Sub

bonne soirée

 

[vbacrumble]

Re : Récupération propriété title - .xla ?

Bonjour


Essayes ceci:

Private Sub CommandButton2_Click()
Dim WB As Workbook, Chemin$, nfich$, Titre$
Chemin = ThisWorkbook.Path & "\"  'changer le nom du dossier selon vos besoins
nfich = Dir(Chemin & "*.xls")
Do While nfich <> ""
[COLOR="Blue"]If nfich = ThisWorkBook.Name Then Exit Sub[/COLOR]
    Workbooks.Open Filename:=Chemin & nfich
    If Sheets(1).Range("I4").Text <> "" Then
    Titre = Sheets(1).Range("I4").Text
Else
    Titre = Sheets(1).Range("H4").Text
End If
    Workbooks(nfich).BuiltinDocumentProperties("Title").Value = Titre
    Workbooks(nfich).Close True
nfich = Dir
Loop
End Sub

 

[starz]

Re : Récupération propriété title - .xla ?

ça ne focntionne toujours pas 😕