Ce code est permet de déproteger Excel 2007 (testé):

Sub enleve_protection()

Dim a, b, c, d, e, f, g, h, i, j, k, l As Integer
On Error Resume Next
For a = 65 To 66
For b = 65 To 66
For c = 65 To 66
For d = 65 To 66
For e = 65 To 66
For f = 65 To 66
For g = 65 To 66
For h = 65 To 66
For i = 65 To 66
For j = 65 To 66
For k = 65 To 66
For l = 32 To 126
ActiveSheet.Unprotect Chr(a) & Chr(b) & Chr(c) & _
Chr(d) & Chr(e) & Chr(f) & Chr(g) & Chr(h) & _
Chr(i) & Chr(j) & Chr(k) & Chr(l)
If ActiveSheet.ProtectContents = False Then
MsgBox "La Protection a été enlevée - Un mot de passe satisfaisant est :" & Chr(a) & Chr(b) & _
Chr(c) & Chr(d) & Chr(e) & Chr(f) & Chr(g) & _
Chr(h) & Chr(i) & Chr(j) & Chr(k) & Chr(l)
Exit Sub
End If
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
End Sub

Il y a une semaine, j’ai fait un téléchargement des données sur Internet dont le format de date ne me satisfaisait pas. Je les avais sous cette forme:”20020217″ pour le 17 février 2002. Je voulais les transformer en 17/02/2002. C’était 2 230 lignes de données sur Excel.
J’ai écris ce code que je partage avec vous, qui m’a fait le boulot à merveille.

 

Sub Transforme_date()
Dim i as Double 'boucle pour transformer le format des dates 

For i = 2 To 2500 

Cells(i, 10) = Left(Cells(i, 3), 4) & "/" & Mid(Cells(i, 3), 5, 2) & "/" & Right(Cells(i, 3), 2) 

Next i 

End Sub
 

 

 

 

Il arrive que vous protégiez une feuille de calcul Excel, afin d’éviter que des personnes autres que vous viennent modifier le contenu des cellules. Après des mois, vous oubliez vous mêmes le mot de passe, mais vous devez faire des modifictions sur les cellules protégées. Je mets à votre disposition ce bout de code, qu’il faut coller derrière la feuille à deprotéger.
Pour cela, faites un clic droit sur l’onglet de la feuille (là où se trouve le nom de la feuille), choisir “Visualiser le code”. Une fenêtre s’ouvre. Si vous ne l’avez jamais fait, vous serez en face d’une fenêtre qui sert à la programmation sur Excel.
Collez le code suivant:

Sub EnleveProtection()
ActiveSheet.Protect , , , , True
ActiveSheet.Range("a1").Copy ActiveSheet.Range("a1")
End Sub

Dès que le code est coller, cliquez juste en dessous de “Sub EnleveProtection()”, puis appuyer sur F5 (pour l’exécution).
Rentrez sur la feuille, et vous constaterez que la protection a disparu!
Attention: Ce code n’est valable que les versions d’Excel antérieure à Excel 2003.

Code pour les versions d’Excel supérieures à 97 (2000, XP et 2003)

Sub EnleveProtection2003()
'Déprotège Feuille courante

ActiveSheet.Protect vbNullString, , True, , , , , , , , , , , , , True
ActiveSheet.Unprotect vbNullString

End Sub

Format monétaire

20 août 2007

Sub EnleveLesPoints_New()

'Cette macro enlève les points entre les chiffres
'Ex: 1.500.000  devient 1 500 000
'macro écrite par calvin, le 29 avril 2007
'ce code est à coller dans un module standard (Insertion/module)
On Error Resume Next

Dim Cell As Variant

For Each Cell In Selection    'debut de la boucle

Cell.Value = Replace(Cell.Value, ".", "")  'fonction pour enlever les points entre les chiffres

Next Cell  'Fin de la boucle

'Mise en forme sous un format monétaire
Selection.Style = "Comma"
Selection.NumberFormat = _
"_-* #,##0.0 _€_-;-* #,##0.0 _€_-;_-* ""-""?? _€_-;_-@_-"
Selection.NumberFormat = "_-* #,##0 _€_-;-* #,##0 _€_-;_-* ""-""?? _€_-;_-@_-"

End Sub

Code rapprochement (2)

20 août 2007

Ce code fait le rapprochement des écritures par leur montant en tenant compte d’une partie du libellé

*****************************************************************

***********************************************************************

‘NB: Les informations precédées du signe ‘ sont des commentaires
‘Elles ne sont pas considérées dans l’exécution du code
‘Ce code ne concerne que sur les opérations au crédit. Il est facilement adaptable pour les opérations au débit
‘Pour rapprocher une écriture,Il prend en compte non seulement le montant
‘mais également un element du libellé des opérations NS
‘qui doit correspondre avec un element du libellé des opérations AS.

Sub Rapprochement_Credit_New()

'Cette macro fait le rapprochement des montants nouveau système (NS) et ceux de ancien système (AS)
'macro écrite par calvin, le 29 avril 2007
'les montants rapprochés sont coloriés en vert
Rem NB: Avant d'utiliser ce code, il est conseillé de mettre les montants sous format de séparateur de milliers

Dim i As Long
Dim j As Long
Dim k As Integer
Dim m As Integer
Dim Montant, NumeroAS, NumeroNS 'As Double
Dim TableauNS() As String
Dim TableauAS() As String

With ActiveSheet 'Le code devrait marcher pour la feuille active

For j = 2 To 600 'debut de la boucle sur les montant AS

Montant = Cells(j, 11) 'Recupération de la valeur AS dans cette variable (colonne K, ie n°11)

For i = 2 To 600 'debut de la boucle sur les montant NS au débit

' la fonction Split divise une chaine en fonction des espaces Ex: Plit("je suis en vie", " "), aura en sortie : | je | suis | en | vie |
' Puis on conserve le résultat dans un tableau

TableauNS = Split(Cells(i, 4).Offset(0, -2), " ") 'Fonction dans la colonne des libellés NS
TableauAS = Split(Cells(j, 11).Offset(0, 2), " ") 'Fonction dans la colonne des libellés AS

For k = 0 To UBound(TableauNS) 'Boucle sur le tableau NS

For m = 0 To UBound(TableauAS) 'Boucle sur le tableau AS

'Condition si le montant AS correspond au montant NS (colonne C, ie n°3)
'Et une partie du libellé AS  est contenu dans une partie du libellé de NS

If Cells(i, 4) = Montant _
And TableauAS(m) = TableauNS(k) _
And Cells(i, 4).Interior.ColorIndex <> 4 _
And Cells(j, 11).Interior.ColorIndex <> 4 _
And Imput = "C" Then 'Condition si le montant AS correspond au montant NS (colonne D, ie n°4)
Cells(i, 4).Interior.ColorIndex = 4 'Colorier la cellule du montant NS
Cells(j, 11).Interior.ColorIndex = 4 'Colorier la cellule du montant AS

End If 'Fin de la condition

Next m 'increment de la cellule du tableau AS

Next k 'increment de la cellule du tableau NS

Next i 'increment de la cellule suivante des montants NS

Next j  'increment de la cellule suivante des montants AS

End With 'Fin Feuille active

MsgBox "Lettrage des montants au crédit terminé", vbInformation, "Lettrage " 'Message qui indique la fin du lettrage

End Sub

La boite où je travaille a acquis un nouveau logiciel. Avant son adoption definitive, il était question de vérifier que le nouveau système rendait satisfaction. Il nous a été demandé de saisir les opérations aussi bien dans l’ancien que dans le nouveau. Puis, il fallait que nous nous assurions que les mêmes opérations étaient bien presentes aussi bien dans le nouveau système que dans l’ancien.

Imaginez que vous ayez 100 comptes. Chaque compte enrégistre en moyenne 600 opérations par mois. Chaque mois a environ 24 jours ouvrables. Le travail est à effectuer sur 4 mois. Vous vous retrouvez avec 5 760 000 lignes d’écritures dans chacun des systèmes!  Ce rapprochement entre les deux est fait manuellement!!!

Nous étions au bord de la crise des nerfs quand j’ai finalisé ce bout de code qui nous a sauvé du gouffre. Un compte que nous rapprochions manuellement en 4 heures sans garantie de la justesse, ce code vous le fait automatiquement en 1 mn 20s chrono! C’est incroyable!

Je le partage ici pour qu’il serve à certains, ou qu’il serve de piont de départ à d’autres, ou encore que les informaticiens voient les améliorations que l’on pourrait faire. je vous donneari d’autres bouts de code qui nous ont aidé à resoudre d’autres problèmes qui se sont posés à nous.

Code rapprochement (1)

20 août 2007

Voici un bout de code qui m’a sauvé (ainsi que mes collègues) du surmenage nerveux!

****************************

Sub Rapprochement_Credit()

'Cette macro fait le rapprochement des montants au crédit du nouveau système (NS) et ceux de l'ancien système (AS)

Dim i, j As Long
Dim Montant 'As Double
Dim Imput As String
With ActiveSheet 'Pour la feuille active
For j = 2 To 600 'debut de la boucle sur les montant AS

Montant = Cells(j, 11) 'Recupération de la valeur AS dans cette variable (colonne K, ie n°11)
Imput = Cells(j, 12) 'Recuperation du sens de l'imputation

For i = 2 To 600 'debut de la boucle sur les montant NS au crédit


If Cells(i, 4) = Montant And Cells(i, 4).Interior.ColorIndex <> 4 And Cells(j, 11).Interior.ColorIndex <> 4 And Imput = "C" Then 'Condition si le montant AS correspond au montant NS (colonne D, ie n°4)
Cells(i, 4).Interior.ColorIndex = 4 'Colorier la cellule du montant NS
Cells(j, 11).Interior.ColorIndex = 4 'Colorier la cellule du montant AS
End If

Next i 'increment de la cellule suivante des montants NS

Next j  'increment de la cellule suivante des montants AS

End With

MsgBox "Lettrage des montants au crédit terminé", vbInformation, "Lettrage " 'Message qui indique la fin du lettrage

End Sub

******************************************

‘Une legère adaptation est faite pour rapprocher les montants au débit.

‘Ce code ne tient pas compte des libellés des opérations.

Suivre

Get every new post delivered to your Inbox.