> Tous les forums > Forum Bureautique
 vba modifier boite de dialogue et supprimer fichier
Ajouter un message à la discussion
Page : [1] 
Page 1 sur 1
keval
  Posté le 21/11/2016 @ 22:00 
Aller en bas de la page 
Nouvel astucien



Bonjour,

après avoir récupéré ce code et adapté à mes besoins, je viens vers vous car je butte sur plusieurs problèmes:

en ce moment la macro ouvre un boite de dialogue et je choisi le dossier où se trouve mes fichiers word et ouvre le premier .
ce que j'aimerai c'est pouvoir sélectionner le fichier à traiter et que la boite de dialogue s'ouvre sur le dossier où se trouve mes fichiers word. et que lorsqu'elle ferme le fichier elle le supprime.

ci-joint ma macro.

Merci d'avance.

[Configuration automatique à compléter]

excel2007

Option Explicit

' ----------------------------------------------------------------

' Extraction des données à partir de fichier Word vers Excel

'-----------------------------------------------------------------

Sub Importation_Donnees_Word()

' -- Déclaration des variables

Dim wb As Workbook 'classeur Excel dans lequel on importe les données

Dim ws As Worksheet 'onglet Excel dans lequel on importe les données

Dim sChemin As String 'répertoire contenant les fichiers Word

Dim sNomFichier As String 'nom du fichier Word

Dim WApp As Object, WDoc As Object, WSel As Object

' -- Initialisation des variables

Set wb = ThisWorkbook

Set ws = wb.Sheets(1) 'on sauvegarde dans la 1re feuille

sChemin = ChoisirRepertoire & "\" 'fonction pour choisir le répertoire contenant les fichier Word

'sChemin = ThisWorkbook.Path & "\" 'si les fichiers Word se trouvent dans le même répertoire que le fichier Excel

sNomFichier = Dir(sChemin & "*.doc*") 'pour ouvrir tous les fichiers .doc*. 1er fichier.

Set WApp = CreateObject("Word.Application") 'pour créer un objet Word

WApp.Visible = False 'ne pas afficher Word pendant l'exécution

Application.ScreenUpdating = False

Set WDoc = WApp.Documents.Open(sChemin & sNomFichier) 'ouvre le document Word

' Nom ou raison sociale (par la fonction FIND)

WApp.Selection.HomeKey unit:=6

WApp.Selection.Find.ClearFormatting

WApp.Selection.Find.Execute "NOM :"

WApp.Selection.MoveLeft unit:=wdWord, Count:=9, Extend:=4

Set WSel = WApp.Selection

ws.Range("B3") = Trim(Split(WSel, "l'installation")(1))

' adresse (par la fonction FIND)

WApp.Selection.HomeKey unit:=6

WApp.Selection.Find.ClearFormatting

WApp.Selection.Find.Execute "Adresse 1 :"

WApp.Selection.MoveLeft unit:=wdWord, Count:=12, Extend:=4

Set WSel = WApp.Selection

ws.Range("B4") = Trim(Split(WSel, "comptage")(1))

' code postal (par la fonction FIND)

WApp.Selection.HomeKey unit:=6

WApp.Selection.Find.ClearFormatting

WApp.Selection.Find.Execute "code postal :"

WApp.Selection.MoveLeft unit:=wdWord, Count:=10, Extend:=4

Set WSel = WApp.Selection

ws.Range("B5") = Trim(Split(WSel, ":")(1))

' commune (par la fonction FIND)

WApp.Selection.HomeKey unit:=6

WApp.Selection.Find.ClearFormatting

WApp.Selection.Find.Execute "Commune :"

WApp.Selection.MoveLeft unit:=wdWord, Count:=10, Extend:=4

Set WSel = WApp.Selection

ws.Range("B6") = Trim(Split(WSel, ":")(1))

' date (par la fonction FIND)

WApp.Selection.HomeKey unit:=6

WApp.Selection.Find.ClearFormatting

WApp.Selection.Find.Execute "Date de relevé des index :"

WApp.Selection.MoveRight unit:=wdWord, Count:=6, Extend:=4

Set WSel = WApp.Selection

ws.Range("B1") = Trim(Split(WSel, ":")(1))

' interlocuteur (par la fonction FIND)

WApp.Selection.HomeKey unit:=6

WApp.Selection.Find.ClearFormatting

WApp.Selection.Find.Execute "Nom de l'interlocuteur 1 :"

WApp.Selection.MoveLeft unit:=wdWord, Count:=11, Extend:=4

Set WSel = WApp.Selection

ws.Range("D2") = Trim(Split(WSel, ":")(1))

' telephone (par la fonction FIND)

WApp.Selection.HomeKey unit:=6

WApp.Selection.Find.ClearFormatting

WApp.Selection.Find.Execute "N° Tél. de l'interlocuteur 1 :"

WApp.Selection.MoveLeft unit:=wdWord, Count:=12, Extend:=4

Set WSel = WApp.Selection

ws.Range("D3") = Trim(Split(WSel, ":")(1))

WDoc.Close False 'fermer le document Word sans enregistrer

SortieNormale:

Application.ScreenUpdating = True

WApp.Quit 'Fermer l'instance de Word

Application.StatusBar = False 'Remise à zéro de la barre d'état

End Sub

Function ChoisirRepertoire() As String

' -- Fonction permettant de choisir un répertoire

Dim oRepertoire As Object

ChoisirRepertoire = ""

Set oRepertoire = CreateObject("Shell.Application").BrowseForFolder(0, "Choisir un répertoire", 0)

If (Not oRepertoire Is Nothing) Then ChoisirRepertoire = oRepertoire.Items.Item.Path

Set oRepertoire = Nothing

End Function





Modifié par keval le 21/11/2016 22:06
Publicité
Titus68
 Posté le 22/11/2016 à 00:31 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Astucien

Pour la selection de fichier avec browseforfolder il faut indiquer &H4000 à la place de 0 (le 1er paramètre), exemple :

https://forum.pcastuces.com/vba_modifier_boite_de_dialogue__et_supprimer_fichier-f23s37147.htm

Sinon on peut utiliser à la place de browseforfolder, le common dialog file open .

keval
 Posté le 22/11/2016 à 08:27 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Nouvel astucien

Bonjour,

merci pour l'info , javzis deja essayé mais il me mes en erreur des que j'éxcute la macro car elle essaye d'ouvrir automatiquement un fichier Word

Page : [1] 
Page 1 sur 1

Vous devez être connecté pour poster des messages. Cliquez ici pour vous identifier.

Vous n'avez pas de compte ? Créez-en un gratuitement !


Les bons plans du moment PC Astuces

Tous les Bons Plans
141,99 €SSD externe portable USB 3.1 SanDisk Extreme 1 To à 141,99 €
Valable jusqu'au 20 Février

Amazon fait une promotion sur le SSD externe portable USB 3.1 SanDisk Extreme 1 To qui passe à 141,99 € livré gratuitement alors qu'on le trouve à 180 € ailleurs. Le disque SSD SanDisk Extreme portable est plus de deux fois plus petit que la taille de votre smartphone et fournit jusqu'à 5 fois la vitesse d'un disque dur portable. Apprenez à travailler en quelques secondes, transférez de grandes bibliothèques de vidéos et de photos à des vitesses pouvant atteindre 550 Mo/s. Vous ne craindrez pas de l'emporter partout avec vous grâce à sa conception robuste et résistante avec un coeur de SSD résistant aux chocs. Le logiciel SanDisk inclu SecureAccess peut crypter vos fichiers personnels. Garantie 3 ans. Résiste à l'eau (IP55). Interface : USB 3.1 Type A et C.


> Voir l'offre
79,99 €Kit 5.1 Logitech Z607 bluetooth à 79,99 €
Valable jusqu'au 19 Février

Amazon fait une promotion sur le kit d'enceintes 5.1 Logitech Z607 qui passe à 79,99 € livré gratuitement alors qu'on le trouve ailleurs autour de 125 €. Ce kit dispose d'un caisson de basses, d'une voie centrale et de 4 satellites offrant au total  une puissance de crête de 160 Watts et 80 Watts en puissance RMS. De quoi profiter pleinement de vos films et de vos jeux dans une pièce moyenne. D'autant que des câbles extra-longs (6,2 m) sont fournis pour les satellites arrières. Grâce à ses entrées 3.5mm et RCA, vous pourrez relier le kit à un PC, à une console de jeux, un lecteur DVD/Blu-Ray tandis que sa connexion bluetooth vous permettra de l'utiliser pour vos appareils sans fil. Vous pouvez même lui brancher directement une carte mémoire ou une clé USB et écouter la radio FM. Une télécommande (sans fil) vous permettra de contrôler tout cela. Une excellente affaire !


> Voir l'offre
599,99 €Portable 15,6 pouces HP (FullHD, Core i5, 8 Go, SSD 128 Go + DD 1 To, GTX 1050 3 Go) à 599,99 €
Valable jusqu'au 22 Février

Cdiscount fait une belle promotion sur l'ordinateur portable HP Pavilion 15-bc511nf qui passe à 599,99 € livré gratuirement alors qu'on le trouve ailleurs autour de 700 €. Ce portable possède un écran 15,6 pouces HD Full HD (1920x1080), un processeur Intel Core i5 9300H, 8 Go de RAM, un SSD de 128 Go, un disque dur de 1 to et une carte graphique dédiée GeForce GTX 1050 3 Go. Le tout tourne sous Windows 10.


> Voir l'offre

Sujets relatifs
Aucun sujet pertinent lié trouvé
 > Tous les forums > Forum Bureautique