Copiez la macro qui vous intéresse
Pour utiliser les valeurs entrées dans les InputBox pour nommer les dossiers que vous créez via une macro VBA, vous devez stocker ces valeurs dans des variables. Ensuite, vous pouvez utiliser ces variables pour créer les dossiers.
‘SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
‘Voici un exemple de code qui vous montre comment capturer les valeurs des InputBox dans des variables et créer des dossiers avec ces noms :
‘RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR
‘En VBA
Sub CreerDossiers()
Dim nomDossier1 As String
Dim nomDossier2 As String
Dim chemin As String
‘ Demander à l’utilisateur les noms des dossiers
nomDossier1 = InputBox(« Entrez le nom du premier dossier : »)
nomDossier2 = InputBox(« Entrez le nom du deuxième dossier : »)
‘ Spécifier le chemin où les dossiers seront créés
chemin = « C:\Chemin\vers\votre\dossier\ » ‘ Modifiez le chemin selon votre besoin
‘ Vérifier si les noms des dossiers ont été fournis
If nomDossier1 <> « » And nomDossier2 <> « » Then
‘ Créer le premier dossier
MkDir chemin & nomDossier1
MsgBox « Le dossier ‘ » & nomDossier1 & « ‘ a été créé dans » & chemin
‘ Créer le deuxième dossier
MkDir chemin & nomDossier2
MsgBox « Le dossier ‘ » & nomDossier2 & « ‘ a été créé dans » & chemin
Else
MsgBox « Veuillez fournir des noms pour les dossiers. »
End If
End Sub
« `
Ce code utilise deux variables (`nomDossier1` et `nomDossier2`) pour stocker les valeurs entrées par l’utilisateur via les InputBox. Assurez-vous de modifier la variable `chemin` avec le chemin d’accès réel où vous souhaitez créer vos dossiers.
Ce code crée deux dossiers en utilisant les noms fournis dans les InputBox. Il vérifie également si les noms des dossiers ont été fournis avant de créer les dossiers.
N’hésitez pas à adapter ce code en fonction de vos besoins spécifiques ou à poser d’autres questions si nécessaire !
‘SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
‘Pour piloter un segment de carte choroplèthe dans Excel à l’aide de VBA
‘RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR
Sub FiltrerSegmentCarte()
Dim ws As Worksheet
Dim segment As SlicerCache
Dim item As SlicerItem
‘ Remplacez « Feuil1 » par le nom de votre feuille de travail
Set ws = ThisWorkbook.Sheets(« Feuil1 »)
‘ Remplacez « NomDuSegment » par le nom de votre segment de carte
Set segment = ThisWorkbook.SlicerCaches(« NomDuSegment »)
‘ Remplacez « ÉlémentÀFiltrer » par le nom de l’élément que vous souhaitez filtrer
Set item = segment.SlicerItems(« ÉlémentÀFiltrer »)
‘ Effacer tous les filtres actuels
segment.ClearManualFilter
‘ Appliquer le filtre à l’élément spécifié
item.Selected = True
End Sub
‘SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
‘Pour Enlever tous les filtres d’un tableau
‘RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR
Sub FiltreZero()
‘ On enlève la protection de la feuille
ActiveSheet.Unprotect
‘On remet toutes les Valeurs filrées à zéro
ActiveSheet.ShowAllData
End Sub
‘SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSRRRRRRR
‘Pour afficher un Message de dépassement de Date
‘RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR
Private Sub Workbook_Open()
Application.ScreenUpdating = False ‘l’utilisateur ne voit pas les scintillements sur son écran
‘Définissez la date d’expiration
DateExpiration = DateSerial(2021, 12, 31) ‘ <= choisissez la date d’expiration >>> via la fonction DateSerial avec les paramètres (aaaa, mm, jj)
‘compare la date d’expiration avec la date d’aujourd’hui
If DateExpiration <= Date Then
‘Vous pouvez afficher par exemple un message tel que :
MsgBox « Ce fichier n’est plus utilisable ! »
Else
End If
Application.ScreenUpdating = True ‘on réenclenche l’affichage des changements
End Sub
‘SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
‘Pour rendre un fichier inutilisable à une date déterminée
‘RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR
‘Code à placer dans l’objet ThisWorkbook de votre Classeur:
Private Sub Workbook_Open()
Application.ScreenUpdating = False ‘l’utilisateur ne voit pas les changement sur son écran
‘Définissez la date d’expiration
DateExpiration = DateSerial(2021, 12, 31) ‘ <= choisissez la date d’expiration >>> via la fonction DateSerial avec les paramètres (aaaa, mm, jj)
‘compare la date d’expiration avec la date d’aujourd’hui
If DateExpiration <= Date Then
Application.DisplayAlerts = False ‘on empêche les pop-ups pour confirmer la suppression des Feuilles d’apparaître
‘fermeture automatique et immédiate du Classeur
ThisWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True ‘on réenclenche l’affichage des pop-ups de confirmation/alerte
Else
End If
Application.ScreenUpdating = True ‘on réenclenche l’affichage des changements
End Sub
‘SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
‘Supprime tout le contenu du fichier sur un dépassement de Date
‘RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR
‘Ce code est à placer dans l’Objet « ThisWorkbook » (comme expliqué pour le code de base plus haut).
Private Sub Workbook_Open()
Application.ScreenUpdating = False ‘l’utilisateur ne voit pas les changement sur son écran
‘lDéfinissez la date d’expiration
DateExpiration = DateSerial(2021, 12, 31) ‘ <= choisissez la date d’expiration >>> via la fonction DateSerial avec les paramètres (aaaa, mm, jj)
‘compare la date d’expiration avec la date d’aujourd’hui
If DateExpiration <= Date Then
Application.DisplayAlerts = False ‘on empêche les pop-ups pour confirmer la suppression des Feuilles d’apparaître
‘on supprime toutes les Feuilles sauf la feuille active
Dim Feuille As Worksheet
For Each Feuille In ThisWorkbook.Worksheets
If Feuille.Name <> ActiveSheet.Name Then Feuille.Delete
Next Feuille
‘on supprime le contenu de la Feuille restante
ActiveSheet.Cells.Delete Shift:=xlUp
‘on sauvegarde le fichier pour rendre la suppression du contenu permanente
ThisWorkbook.Save
Application.DisplayAlerts = True ‘on réenclenche l’affichage des pop-ups de confirmation/alerte
Else
End If
Application.ScreenUpdating = True ‘on réenclenche l’affichage des changements
End Sub
‘SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
‘Auto-destruction du fichier sur un dépassement de Date
‘RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR
‘Attention c’est une action irréversible !
« ThisWorkbook » de votre Projet VBA…
Private Sub Workbook_Open()
Application.ScreenUpdating = False ‘l’utilisateur ne voit pas les changement sur son écran
‘Définissez la date d’expiration
DateExpiration = DateSerial(2021, 12, 31) ‘ <= choisissez la date d’expiration >>> via la fonction DateSerial avec les paramètres (aaaa, mm, jj)
‘compare la date d’expiration avec la date d’aujourd’hui
If DateExpiration <= Date Then
‘autodestruction de fichier Excel (le fichier s’efface lui-même)
Dim NomComplet As String
NomComplet = Application.ActiveWorkbook.FullName
ActiveWorkbook.Saved = True
Application.ActiveWorkbook.ChangeFileAccess xlReadOnly
Kill NomComplet
Application.ActiveWorkbook.Close False
Else
End If
Application.ScreenUpdating = True ‘on réenclenche l’affichage des changements
End Sub
‘SSSSSSSSSSSSSSSSSSSSSSSS
‘Pour afficher le plein écran
‘RRRRRRRRRRRRRRRRRRRRR
‘SSSSSSSSSSSSSSSSSSSSSSSS
‘Pour enlever le plein écran
‘RRRRRRRRRRRRRRRRRRRRR
‘SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
‘Réinitialise la protection de la feuille (si vous avez perdu ou oublié votre mot de passe).
‘RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR
Sub Reinitialise_MotdDePasse()
Dim i As Integer, j As Integer, k As Integer
Dim l As Integer, m As Integer, n As Integer
Dim i1 As Integer, i2 As Integer, i3 As Integer
Dim i4 As Integer, i5 As Integer, i6 As Integer
On Error Resume Next
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
If ActiveSheet.ProtectContents = False Then
MsgBox « TADAH ! Le PassWord est : » & Chr(i) & Chr(j) & _
Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
Exit Sub
End If
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
End Sub
________________________
‘SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
‘Changement de couleur des Cellules
‘RRRRRRRRRRRRRRRRRRRRRRRRRRRR
Sub CelluleVerte()
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5287936
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
Sub CelluleOrange()
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
Sub CelluleRouge()
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
________________________
‘SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
‘ Vide une plage déterminée de toutes les données
‘RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR
Sub EffaceLeContenu()
If MsgBox(« Voulez-vous vraiment effacer tout le contenu ? » & Chr(13) _
& « Je vous conseille de faire une sauvegarde de votre fichier avant de continuer! », _
vbYesNo, « SER_Création ») = vbNo Then Exit Sub
Application.ScreenUpdating = False »
Range(« J12:NK23 »).Select ‘On Sélectionne la Plage de J12 à NK23 Sélectionnez votre propre plage
Selection.ClearContents ‘ On supprime le contenu
Range(« A1 »).Select ‘On sélectionne la cellule A1
End Sub
________________________
Sub Repositionnement()
ActiveSheet.Select ‘On sélectionne la feuille active
Range(« A41 »).Show ‘On se rend sur la cellule A41 ou celle de votre choix
End Sub
________________________
Sub RetourDebutTableau()
ActiveSheet.Select ‘On sélectionne la feuille active
Range(« A1 »).Show ‘On se rend sur la cellule A1 ou celle de votre choix
End Sub
________________________
‘SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
‘Fige les colonnes à gauche de la colonne « J » et le lignes de 1 à 11
‘RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR
Sub FigeVolet()
Application.EnableEvents = False
ActiveWindow.FreezePanes = False
If ActiveWindow.ScrollColumn = 1 Then
Range(« J12 »).Select
Else
Range(« A12 »).Select
End If
ActiveWindow.FreezePanes = True
Application.EnableEvents = True
End Sub
________________________
‘SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
‘Fige les lignes de 1 à 11 afin de laisser visibles les onze premières lignes.
‘RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR
Sub DefigeVolet()
Application.EnableEvents = False
ActiveWindow.FreezePanes = False
ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
Range(« A12 »).Select
ActiveWindow.FreezePanes = True
Application.EnableEvents = True
End Sub
________________________
Sub Centrer_sur_plusieurs_colonnes()
With Selection
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
End Sub
________________________
‘SSSSSSSSSSSSSSSSSSSSSSSSSS
‘Met en majuscule la sélection
‘RRRRRRRRRRRRRRRRRRRRRRR
Sub Majuscule()
Dim cellule As Range
For Each cellule In Selection
cellule = UCase(cellule)
Next
End Sub
________________________
‘SSSSSSSSSSSSSSSSSSSSSSSSSS
‘Met en minuscule la sélection
‘RRRRRRRRRRRRRRRRRRRRRRR
Sub Minuscule()
Dim cellule As Range
For Each cellule In Selection
cellule = LCase(cellule)
Next
End Sub
________________________
‘SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
‘permet d’afficher les lignes masquées dans la sélection
‘RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR
Sub affiche_ligne()
Selection.EntireRow.Hidden = False
End Sub
________________________
‘SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
‘permet de masquer les lignes dans la sélection
‘RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR
Sub masque_ligne()
Selection.EntireRow.Hidden = True
End Sub
________________________
‘SSSSSSSSSSSSSSSSSSSSSSSSSSS
‘Met en nom propre la sélection
‘RRRRRRRRRRRRRRRRRRRRRRRR
Sub Nom_propre()
Dim cellule As Range
For Each cellule In Selection
cellule = Application.Proper(cellule)
Next
End Sub
________________________
‘SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
‘Positionner un image dans une feuille Excel à un endroit choisi.
‘RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR
‘Déclaration des Variables Globales
Dim Dossier As Object
Dim NomFichier As String
Dim CheminImage As String
________________________
Sub AfficheImage()
‘Affectation de laVariable
Set Dossier = Application.FileDialog(msoFileDialogOpen)
‘Personnaliez l’explorateur de Fichiers
With Dossier
.Title = « Insérez l’image que vous souhaitez insérer »
.InitialFileName = « »
.Filters.Clear
.AllowMultiSelect = False
If .Show <> 0 Then
NomFichier = .SelectedItems(1) ‘ On sélectionne l’Image
Else
MsgBox « Vous n’avez pas sélectionné de Fichier ! », vbOKOnly + vbInformation, « RECOMMENCEZ »
End If
End With
‘On affiche le nom du dossier dans la cellule A41ou celle que vous avez choisi
ActiveSheet.Range(« A43 ») = NomFichier
‘Si pas d’image on passe à l’étape suivante
On Error Resume Next
‘On récupère l’image et on la positionne dans la cellule U1 ou celle que vous avez choisi
With ActiveSheet
‘On supprime l’image déjà existante
.Shapes(« ImagedeJanvier »).Delete
‘On affiche l’image
CheminImage = .Range(« A43 ») ‘ On récupère le chemin complet de l’image
.Range(« U1 »).Select ‘On se positionne sur la cellule qui va réceptionner l’image
‘On manipule l’image
With .Pictures.Insert(CheminImage)
‘On positionne et on redimensionne l’image
With .ShapeRange
.LockAspectRatio = msoTrue ‘On garde les proportions
‘On la redimensionne
.Height = 130
.Width = 130
‘On la positionne
.Left = .Range(« U1 »).Left
.Top = .Range(« U1 »).Top
‘On la renomme
.Name = « ImagedeJanvier »
‘On décale l’image dans la cellule
.IncrementLeft = 20
.IncrementTop = 50
End With
End With
End With
End Sub
________________________
Abonnez-vous à ma Newsletter Cliquez sur l’image !
________________________
‘SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
‘Supprime les doubles espaces dans la selection
‘RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR
Sub Supr_espace()
Dim cellule As Range
For Each cellule In Selection
cellule = Application.Trim(cellule)
Next
End Sub
________________________
‘SSSSSSSSSSSSSSSSSSSSSSSSSSSS
‘Convertir en nombre la sélection
‘RRRRRRRRRRRRRRRRRRRRRRRRR
Sub Minuscule()
Dim cellule As Range
For Each cellule In Selection
cellule = Cnum(cellule)
Next
End Sub
________________________
‘SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
‘Imprime le fichier avec l’imprimante par défaut
‘RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR
Sub ImprimerFichier()
Dim NomFichier As String
Dim x As Long
Dim sCurPrinter As String
‘Change l’imprimante par défaut dans excel
sCurPrinter = Application.ActivePrinter
Application.ActivePrinter = « Nom de l’imprimante tel qu’il est affiché dans le panneau de configuration »
‘Recherche le fichier
x = FindWindow(« XLMAIN », Application.Caption)
NomFichier = « C:\.pdf »
‘Imprime le fichier
ShellExecute x, « print », NomFichier, « », « », 1
‘Redéfinie l’imprimante par défaut dans excel
Application.ActivePrinter = sCurPrinter
End Sub
________________________
‘SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
‘Arrête le calcul pour le bon déroulement de la Macro
‘RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR
Sub StartStopCalcul()
If Application.Calculation = xlAutomatic Then
With Application
.Calculation = xlManual
.MaxChange = 0.001
.CalculateBeforeSave = True
End With
‘
End If
End Sub