03 novembre 2009
Contrôle de saisie
En réponse à un p'tit problème de saisie sur Userform, je vous livre ici ma p'tite méthode pour s'assurer que l'utilisateur saisisse des info valides et conformes à l'attente tout en aidant la saisie.
En effet, il est classique de demander la saisie de chiffre et/ou de date à l'utilisateur via un beau Userform que vous avez mis un temps fou à concevoir. Il en reste pas moins que si des garde-fou ne vont pas avec, l'utilisateur pourra saisir n'importe quoi dans un champs devant contenir un nombre (une somme pas exemple) ou une date.
Ainsi la méthode ici exposée, interdit tout simplement la saisie de caractères autre que des chiffres et les signes . (point) et / (slash). Le point sera transformé en virgule si, comme moi, vous avez configuré votre ordi en utilisation clavier français et le slash est utile pour la saisie des dates.
Pour détailler le code, tout d'abord noter la déclaration de 2 constantes "publiques" :
Public Const Touche = "1234567890&é""""'(-è_çà,;:"
Public Const ToucheMaj = "123456789012334567890../"
Ces 2 constantes sont les caractères "autorisés" pour l'une et la traduction pour l'autre. En effet, le deuxième aspect de la question est de faciliter la saisie, pour ceux qui n'ont pas de pavé numérique ,en leur permettant de taper sur la touche des chiffres sans appuyer sur la touche Majuscule en même temps.
Par la suite, le code de votre userform sera agrémenté par les lignes suivantes (pour chaque textbox) :
Private Sub textbox1_keyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If InStr(Touche, Chr(KeyAscii)) = 0 Then KeyAscii = 0 Else _
KeyAscii = Asc(Mid(ToucheMaj, InStr(Touche, Chr(KeyAscii)), 1))
End Sub
En clair : si la touche enfoncée correspond à un signe valide (listé dans la constante "Touche"), on le transforme dans le signe correspondant valide (listé dans la constante "ToucheMaj")
Voilà tout, en quelques lignes de code, votre saisie est sécurisée et facilitée!
tatiak
Téléchargement de : Controle_saisie.zip
28 juin 2009
"Piloter" Word depuis Excel - 3ème partie
Pour continuer, ce sujet : vos données sont maintenant transcrites dans votre document word, et un peu de mise en forme vous est nécessaire pour les mettre en valeur. Voyons plutôt.
Pour cette démonstration, on suppose que les données à transcrire sont la résultante de plusieurs données Xl.
Votre variable "Transit" sera à 2 dimensions et le texte à écrire pourrait être par exemple :
Texte_à_transcrire= "Article : " & Transit(1, i) & vbcr & Transit(2, i) & vbtab & Transit(3,i)
Vous noterez ici l'intégration de retour chariot "vbcr" pour mettre à la ligne et d'une tabulation "vbtab" pour laquelle il peut être prévu le positionnement préalable d'un taquet dans le document word "de base".
L'intégration de la ligne donnera donc :
With WordDoc.Tables(1)
For i = 1 To Nbdonnées
Texte_à_transcrire= "Article : " & Transit(1, i) & vbcr & Transit(2, i) & vbtab & Transit(3,i)
ligne = .Rows.Count
.Cell(ligne, 1).Range.InsertAfter Texte_à_transcrire
next i
end with
Pour mettre en évidence l'intitulé "Article" contenu dans le texte, on va demander gentillement à "l'application Word" (Dim WordApp As Word.Application) de repérer le mot, de le mettre en gras et de le souligner (par exemple) :
With WordApp.ActiveDocument.Content.Find
.Text = "Article : "
.Forward = False
.Execute
If .Found = True Then
.Parent.Underline = wdUnderlineSingle
.Parent.Bold = True
End If
End With
Pour placer ces lignes dans le code :
With WordDoc.Tables(1)
For i = 1 To Nbdonnées
Texte_à_transcrire= "Article : " & Transit(1, i)
& vbcr & Transit(2, i) & vbtab & Transit(3,i)
ligne = .Rows.Count
.Cell(ligne, 1).Range.InsertAfter Texte_à_transcrire
With WordApp.ActiveDocument.Content.Find
.Text = "Article : "
.Forward = False
.Execute
If .Found = True Then
.Parent.Underline = wdUnderlineSingle
.Parent.Bold = True
End If
End With
next i
end with
Voilà, tout, il est possible, et même certain, que ces lignes peuvent être améliorées, je suis preneur de toutes suggestions. Ce que je peux vous dire, c'est que ça "fait le job" dans une applic utilisée quotidiennement dans mon boulot.
Merci par avance des commentaires que vous me laisserez, tatiak
"Piloter" Word depuis Excel - 2ème partie
Pour continuer les explications du 14 juin, et pour aller plus loin, voici comment compléter un tableau dans un document Word depuis Excel.
L'idée ici est de mettre en page des données Xl en adaptant la taille du tableau word avec la quantité de données à insérer.
Nous avons donc créé un document word comme indiqué précédemment dans lequel figure un tableau. Je vous suggère de faire un tableau ne contenant qu'une seule ligne qui sera vide (pour cet exemple un tableau d'une seule colonne sera utilisé, le principe pour plusieurs est le même)
Dans un premier temps, les données Xl seront lues et placées dans une variable de "transit" (ici pour l'exemple les données sont dans la colonne A):
Dim Transit() as string, Nbdonnées as integer, i as integer
Nbdonnées = Feuil1.Range("A65000").End(xlUp).Row
Redim Transit(Nbdonnées) ' pour dimensionner dynamiquement la variable
For i = 1 To Nbdonnées
Transit(i)= Feuil1.cells(i,1).value
next i
Après ouverture du fichier word (comme indiqué dans le post précédent), on place la première données dans le tableau (ici table(1)), puis on ajoute éventuellement une nouvelle ligne dans le tableau pour pouvoir placer la données suivante :
With WordDoc.Tables(1)
For i = 1 to Nbdonnées
ligne = .row.count
.Cell(ligne, 1).Range.InsertAfter Transit(i)
If i < Nbdonnées Then .Rows.Add
Next i
end with
Et voilà à la suite, il convient de fermer proprement le fichier Word comme indiqué précedemment et votre document est mis à jour!
tatiak
14 juin 2009
"Piloter" Word depuis Excel - 1ère partie
Quoi de plus confortable de pouvoir générer un document mis en page avec Word depuis une base de données Excel! En effet, de cette manière, on profite entièrement de la puissance d'un vrai logiciel de traitement de texte, et on peut aller plus loin qu'une fusion de base, pour "mettre en valeur" nos données Excel.
Pour répondre à des demandes multiples, je vous donne ma p'tite méthodologie, en expliquant ici l'insertion de données à l'emplacement d'un signet (pour le nom du client par exemple) et dans un tableau (pour les articles commandés par exemple)
Donc, pour ce type de besoin, je crée un document word qui me sert de modèle (ici dans l'exemple ModèleDocument.doc, situé dans un sous répertoire Document), si besoin avec signet (nommé ici "SIGNET_A CREER_DANS_DOCUMENT_WORD") et tableau (ici un seul tableau donc wordDoc.tables(1)).
Dans un premier temps, la macro crée une instance Word et ouvre le modèle :
Sub Vers_Word()
Dim NDF As String, NDF2 As String
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
NDF = ActiveWorkbook.Path & "\ModèleDocument.doc"
NDF2 = ActiveWorkbook.Path & "\Document" & Sheets("Feuil1").Range("A1").text & ".doc"
On Error Resume Next
Set WordApp = CreateObject("Word.Application")
Set WordDoc = WordApp.Documents.Open(NDF, ReadOnly:=False)
A noter : on prévoit dès le début de sauvegarder le document avec
un nom comportant ici le contenu de la cellule A1 (un nom de client par
exemple) pour ne pas écraser le modèle.
Puis il convient d'écrire les données :
* pour écrire à partir du signet "SIGNET_A CREER_DANS_DOCUMENT_WORD" (ici le contenu de la cellule A2 :
With WordApp
.Visible = False
.Selection.Goto What:=wdGoToBookmark, Name:="SIGNET_A CREER_DANS_DOCUMENT_WORD"
.Selection.TypeText Text:= Sheets("Feuil1").Range("A2").Value
* pour écrire dans le tableau 1 ligne 1, colonne 2 (ici le contenu de la cellule A3) :
With WordDoc.Tables(1)
.Cell(1, 2).Range.InsertAfter Sheets("Feuil1").Range("A3").Value
End With
Ne pas oublier de sauvegarder le document sous le nom défini précédemment :
WordDoc.Application.ActiveDocument.SaveAs NDF2
Enfin, il convient de fermer le tout proprement et de libérer la mémoire en mettant les variables à zéro :
WordApp.Application.Quit
Set WordDoc = Nothing
Set WordApp = Nothing
Ce qui donne au global :
Sub Vers_Word()
Dim NDF As String, NDF2 As String
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
NDF = ActiveWorkbook.Path & "\ModèleDocument.doc"
NDF2 = ActiveWorkbook.Path & "\Document" & Sheets("Feuil1").Range("A1").text & ".doc"
On Error Resume Next
Set WordApp = CreateObject("Word.Application")
Set WordDoc = WordApp.Documents.Open(NDF, ReadOnly:=False)
With WordApp
.Visible = False
.Selection.Goto What:=wdGoToBookmark, Name:="SIGNET_A CREER_DANS_DOCUMENT_WORD"
.Selection.TypeText Text:= Sheets("Feuil1").Range("A2").Value
With WordDoc.Tables(1)
.Cell(1, 2).Range.InsertAfter Sheets("Feuil1").Range("A3").Value
End With
End With
WordDoc.Application.ActiveDocument.SaveAs NDF2
WordApp.Application.Quit
Set WordDoc = Nothing
Set WordApp = Nothing
End Sub
La référence MS Word machin est activée bien sûr!
Et voili!
tatiak
PS : Dans le post à venir, je vous expliquerais comment faire de la mise en forme du texte contenu dans une case d'un tableau (toujours depuis XL dans un document Word), dès son intégration.
PS2 : pour JC, il s'agit bien ici de VBA Excel!
29 mars 2009
Fichiers .mod
Certains appareils de capture vidéo génèrent des fichiers au format .mod. Ces fichiers sont en fait des fichiers mpeg, mais dont l'extension est "personnalisée" par le constructeur de l'appareil pour faire croire à un format propriétaire.
Lors du transfert de ce type de fichier vers son PC, l'exercice consiste à simplement modifier l'extension .mod en .mpg
Plutôt que de faire cette modification à la main pour l'ensemble des fichiers à traiter, rien de tel que quelques lignes de VBS pour automatiser ces opérations. (Attention ceci n'est pas du VBA, mais du VBS ;)).
Option Explicit
Const WINDOW_HANDLE = 0
Const NO_OPTIONS = 0
Dim fso, Chemin, Fichier, FichierItem
Dim NomF, NouveauNomF
Chemin = SelectionDossier("Sélectionner le dossier contenant les fichiers à convertir ","" )
if not Chemin = "ANNULATION" then
on error resume next
beep
Set fso = CreateObject("Scripting.FileSystemObject")
For Each Fichier In fso.GetFolder(Chemin).Files
Set FichierItem = fso.GetFile(Fichier)
NomF = Fichier.name
NouveaunomF = Replace(NomF, ".mod", ".mpg")
fso.MoveFile Chemin & NomF , Chemin & NouveauNomF
next
end if
Function SelectionDossier (message,directory)
Dim objShell, objFolder, objFolderItem
Set objShell = CreateObject("Shell.Application" )
Set objFolder = objShell.BrowseForFolder (WINDOW_HANDLE, message , NO_OPTIONS, directory)
On Error Resume Next
Set objFolderItem = objFolder.Self
If Err <> 0 Then
SelectionDossier = "ANNULATION"
Else
SelectionDossier = objFolderItem.Path & "\"
end if
On Error GoTo 0
set objShell = nothing
set objFolder = nothing
set objFolderItem = nothing
End Function
Télécharger le fichier : ConversionMPG.zip
:) tatiak
29 novembre 2008
Synchronisation Dossiers et Sous-Dossier - VBScript
Avant propos : Et non ce n'est pas du VBA pour Excel, mais du VBS qui "marche tout seul" ;)
Pour faire suite à mon post précédent, et pour aller plus loin dans les contraintes, voici la version suivante du script de synchronisation. En effet, le point "faible" du script précédent est qu'il ne traitait pas les sous-répertoires du dossier choisi.
Voici donc un outil plus complet, capable de traiter les fichiers, les sous répertoires et les fichiers des sous répertoires d'un dossier quelconque à choisir.
Téléchargement de : Synchronisation_DOSSIERS.zip
Dans le code, vous remarquerez 2 fonctions qui sont le "moteur" de l'outil. Une première liste les fichiers du dossier "source" :
Function ListerDossier(Chemin)
Dim Fso, SousRepertoire, SousFichier, SousFichierItem
if right(Chemin, 1) <> "\" then Chemin = Chemin & "\"
On Error Resume Next
Set Fso = CreateObject("Scripting.FileSystemObject")
For Each SousRepertoire In Fso.GetFolder(Chemin).SubFolders
ListerDossier SousRepertoire.Path
Next
For Each SousFichier In Fso.GetFolder(Chemin).Files
Set SousFichierItem = Fso.GetFile(SousFichier)
nbfichiers = nbfichiers +1
ReDim Preserve Tableau(3, nbfichiers)
Tableau(1, nbfichiers) = replace (Chemin, Chemin1 , "")
Tableau(2, nbfichiers) = SousFichier.Name
Tableau(3, nbfichiers) = SousFichierItem.DateLastModified
next
End Function
L'autre fonction liste le contenu du dossier "cible" et effectue le traitement de copie et de mise à jour du contenu de la "source" et de la "cible" :
Function ComparerFichier(Chemin)
Dim Fso, SousRepertoire, SousFichier, SousFichierItem
if right(Chemin, 1) <> "\" then Chemin = Chemin & "\"
On Error Resume Next
Set Fso = CreateObject("Scripting.FileSystemObject")
For Each SousRepertoire In Fso.GetFolder(Chemin).SubFolders
if not Fso.FolderExists(Chemin1 & sousrepertoire.name) then Fso.CreateFolder (Chemin1 & sousrepertoire.name)
ComparerFichier SousRepertoire.Path
Next
for i = 1 to nbfichiers
For Each SousFichier In Fso.GetFolder(Chemin).Files
Set SousFichierItem = Fso.GetFile(SousFichier)
if not Fso.FileExists(Chemin1 & replace(Chemin, Chemin2, "") & SousFichier.name) then
Fso.CopyFile Chemin & SousFichier.Name , Chemin1 & replace(Chemin, Chemin2, ""), true
end if
if tableau(1,i) = replace(Chemin, Chemin2, "") and tableau(2,i) = SousFichier.name then
If CDate(tableau(3,i)) > CDate(SousFichierItem.DateLastModified) Then
Fso.CopyFile Chemin1 & replace(Chemin, Chemin2, "") & tableau(2,i) , Chemin2 & replace(Chemin, Chemin2, ""), true
else
Fso.CopyFile Chemin2 & replace(Chemin, Chemin2, "") & tableau(2,i) , Chemin1 & tableau(1,i) , true
end if
end if
next
if not Fso.FileExists(Chemin2 & tableau(1,i) & tableau(2,i)) then
Fso.CopyFile Chemin1 & tableau(1,i) & tableau(2,i) , Chemin2 & tableau(1,i), true
end if
next
End Function
Voilà tout, n'hésitez pas à me faire part de vos remarques si vous trouvez un bug!
:) tatiak
23 novembre 2008
Synchronisation de dossiers - en VBScript
Bonjour à mes amis lecteurs!
Ma préoccupation du jour est la synchronisation de mes fichiers répartis dans divers dossiers placés sur divers supports (disque dur, clé USB, SdCard de sauvegarde, ...). Ma recherche d'un outil simple de synchronisation n'étant pas concluante, je vous propose ici un utilitaire écrit en VBScript. Simplex peut être, mais il fait le job.
Pour utiliser ces lignes de code, rien de plus simple : copier et coller dans le "Bloc-notes" de Windows, enregistrer le fichier sous un nom le plus explicite pour vous en ajoutant l'extention : .vbs
C'est tout : pour lancer l'utilitaire, vous double-cliquerez dessus, il vous sera demander de choisir un dossier source et un dossier cible, et le script fait le reste!
(la règle de synchro est ici : priorité au fichier le plus récent, et si un fichier n'existe pas dans un des 2 dossiers, il est copié dans l'autre)
Bonne synchro
:) tatiak
option explicit
Const WINDOW_HANDLE = 0
Const NO_OPTIONS = 0
Dim Chemin1, Chemin2
Dim fso, Fichier, FichierItem
Dim NomCible, DateCible
Dim nbfichiers, i
Chemin1 = SelectionDossier("Veuiller sélectionner un dossier SOURCE","" )
if not Chemin1 = "ANNULATION" then
Chemin2 = SelectionDossier("Veuiller sélectionner un dossier CIBLE","" )
if not Chemin2 = "ANNULATION" then
on error resume next
Set fso = CreateObject("Scripting.FileSystemObject")
nbfichiers = 0
For Each Fichier In fso.GetFolder(Chemin1).Files
Set FichierItem = fso.GetFile(Fichier)
nbfichiers = nbfichiers + 1
ReDim Preserve Tableau(2, nbfichiers)
Tableau(1, nbfichiers) = Fichier.Name
Tableau(2, nbfichiers) = FichierItem.DateLastModified
next
for i = 1 to nbfichiers
NomCible = tableau(1,i)
DateCible= tableau(2,i)
For Each Fichier In fso.GetFolder(Chemin2).Files
Set FichierItem = fso.GetFile(Fichier)
if not fso.FileExists(Chemin1 & Fichier.name) then
fso.CopyFile Chemin2 & Fichier.Name , Chemin1, true
end if
if Nomcible =Fichier.name then
If CDate(DateCible) > CDate(FichierItem.DateLastModified) Then
fso.CopyFile Chemin1 & NomCible , Chemin2, true
else
fso.CopyFile Chemin2 & NomCible , Chemin1, true
end if
end if
next
if not fso.FileExists(Chemin2 & Nomcible) then
fso.CopyFile Chemin1 & NomCible , Chemin2, true
end if
next
msgbox "Synchronisation OK! : " & vbCRLF & "Source = " & chemin1 & vbCRLF _
& "Cible = " & chemin2, vbInformation, "Synchronisation dossiers"
end if
end if
Function SelectionDossier (message,directory)
Dim objShell, objFolder, objFolderItem
Set objShell = CreateObject("Shell.Application" )
Set objFolder = objShell.BrowseForFolder (WINDOW_HANDLE, message , NO_OPTIONS, directory)
On Error Resume Next
Set objFolderItem = objFolder.Self
If Err <> 0 Then
SelectionDossier = "ANNULATION"
Else
SelectionDossier = objFolderItem.Path & "\"
end if
On Error GoTo 0
set objShell = nothing
set objFolder = nothing
set objFolderItem = nothing
End Function
Téléchargement de Synchronisation_Fichiers.zip
Edit de décembre : Je vous conseille vivement la lecture du : post suivant! :)
29 juin 2008
Lien hypertexte dans Userform
Avant de partir (bientôt) en vacances, voici une démonstration en VBA de l'utilisation de lien hypertexte à l'intérieur même d'un Userform ou USF (fenêtre de saisie ou de consultation).
L'objectif étant de pouvoir lier facilement des documents complémentaires de format quelconque (Word, Pdf, Images, ...) à une "fiche" d'une base de données sous Excel, pour pouvoir les ouvrir d'un simple clic depuis l'USF.
La démo proposée ici utilise le classique FollowHyperlink pour accéder au fichier lié, mais "l'originalité" de la méthode réside principalement dans la création et la mise à jour du lien directement à partir de l'USF.
Téléchargement de USF_Hypertexte.zip
Téléchargement de USF_Hypertexte_V2.zip
L'utilisation du fichier est très classique : un bouton pour la création d'une nouvelle fiche, un double-clic sur la ligne d'un enregistrement pour la consultation/modification, un double-clic sur un intitulé de l'USF pour "aller chercher" un document à lier, un simple clic sur un lien hypertexte dans la feuille et/ou dans l'USF pour ouvrir le document lié.
Un axe d'amélioration pourrait être la gestion dynamique du nombre de liens possibles par fiche, l'actuelle démo limitant ici le nombre à 3, avec un affichage quelque peu "figé". Mais il faut dire que pour l'utilisation qui a motivé ce développement, ce nombre de 3 est parfaitement adapté. Peut être une idée pour un développe
ment futur ... ?
Bon téléchargement et je compte sur vos commentaires!! ;)
:) tatiak
Edit du 30 juin : Version 2 de la démo : le nom du fichier lié se substitue à l'indication "générique" dans l'USF.
15 avril 2008
Bon de commande - Liaisons Excel-Word
L'exemple du jour est issu d'un cahier des charge intéressant de Dmc.
Le besoin est d'établir des bons de commandes/devis à partir d'un document Word utilisant des données d'une base Excel. L'intérêt ici est de pouvoir profiter de toute la puissance du traitement de texte pour ses qualités de mise en page, intégration du logo de la société, etc... et de toute la puissance de la feuille de calcul pour stocker les données : produits disponibles, options pour chaque produit, base clients et base commandes passées.
La structure de l'outil est simple :
* un fichier Word "modèle" pour établir ses bons de commande - avec fonction d'enregistrement automatique dans un sous dossier,
* un fichier Excel "base" pour stocker la liste des produits, la base clients et la base commandes passées,
* un dossier contenant autant de fichiers Excel que de produits disponibles contenant pour chacun la liste des options à proposer.
L'utilisation est aussi basique, après avoir renseigné vos bases Excel avec vos données, vous établissez le bon de commande devant le client avec le document Word. Le total du devis se met à jour en fonction des options choisies ; et à la fin de l'entretien, il ne vous reste plus qu'à imprimer votre bon (les options non retenues sont alors rayées) et à passer à la signature!
Du point de vue technique, vous trouverez dans cet exemple :
* du VBA Word (une fois n'est pas coutume),
* des liaisons Word-Excel en lecture/écriture dans les 2 sens,
* une gestion des données dans des tableaux Word,
* une gestion des signets,
* une gestion des évènements Word (ici l'impression), ...
Téléchargement de : Bon_de_Commande.zip
L'ensemble est directement prêt à l'emploi (mais limité ici à 11 options par produits).
Pour plus de détails, je vous renvoie à la discussion technique de mise au point de cet outil.
Bon téléchargement, et 'hésitez pas à me laisser vos commentaires!!
:) tatiak
Edit du 18 avril : nouvelle version du fichier, code simplifié et optimisé.
Edit du 19 avril : nouvelle version du fichier, corrige un bug (procédure avant impression).
Edit du 20 avril : version 3.4 - appel de la saisie de l'adresse par clic avant le "C" du mot "Client"
26 décembre 2007
Localisation de ses clients
En réponse à Alain, voici aujourd'hui un utilitaire de localisation de clients sur une carte de France.
Sur cette carte, il est possible de localiser une ville en particulier, ou toutes les villes référencées, ou toutes les villes "Client". Il est également possible d'ajouter toutes les villes dont vous avez besoin.
Un merci à JCGL, testeur et co-auteur de l'utilitaire.
Et merci au site www.hist-geo.com d'où est issue le fond de carte