× Aidez la recherche contre le COVID-19 avec votre ordi ! Rejoignez l'équipe PC Astuces Folding@home
 > Tous les forums > Forum Bureautique
 excel 2016 erreur dans macroSujet résolu
Ajouter un message à la discussion
Page : [1] 
Page 1 sur 1
TJA435
  Posté le 01/06/2020 @ 14:41 
Aller en bas de la page 
Petit astucien

Bonjour,

Dans une macro récupérée sur internet, en la recopiant, j' ai des erreurs que je n' arrive pas à corriger:

voici le code sous un autre forme:

https://www.cjoint.com/c/JFbmMrtLmBB

D' autre part peut-on lister les lignes de code d' une macro ?

Merci pour votre aide.

Publicité
poussebois
 Posté le 01/06/2020 à 16:08 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Maître astucien

Bonjour ,

Si tu pouvais joindre le fichier Excel avec la macro incluse, ce serait mieux !

Et en même temps le lien d'où tu as trouvé la macro.

Pour lister les lignes de code, je procède par un copié/collé dans Word et j'imprime.

@ +

TJA435
 Posté le 01/06/2020 à 17:07 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

Merci pour ta réponse.

Fichier trouvé sur internet :

https://www.cjoint.com/c/JFbpbVyry8B

Fichier excel avec macro

https://www.cjoint.com/c/JFbpcz4caqB

Pour le copier/coller, on perd la couleur ?

Debrief
 Posté le 02/06/2020 à 07:18 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Astucien

Bonjour,

Sans préjuger du résultat, la fonction sur la Feuil2 (officiel) comprend des instructions non séparées sur des lignes différentes et non séparées par ":".

' This is the initial function. It takes in a start date and an end date.
Public Function AgeFunc(stdate As Variant, endate As Variant)
' Dim our variables.
Dim stmon As String
Dim stday As String
Dim styr As String
Dim stdt() As String
Dim endmon As String
Dim endday As String
Dim endyr As String
Dim enddt() As String
Dim stmonf As Integer
Dim stdayf As Integer
Dim styrf As Integer
Dim endmonf As Integer
Dim enddayf As Integer
Dim endyrf As Integer
Dim years As Integer
Dim Date_Fmt As Long
Dim Date_Sep As String
' Find regional parameters
' Date_Fmt --> 0 = mois-jour-année, 1 = jour-mois-année , 2 = année-mois-jour
Date_Fmt = Application.International(xlDateOrder)
Date_Sep = Application.International(xlDateSeparator)
' Parse the day, month and year from the dates.
Select Case Date_Fmt
Case 0
stmon = Split(stdate, Date_Sep)(0)
endmon = Split(endate, Date_Sep)(0)
stday = Split(stdate, Date_Sep)(1)
endday = Split(endate, Date_Sep)(1)
styr = Split(stdate, Date_Sep)(2)
endyr = Split(endate, Date_Sep)(2)
Case 1
stmon = Split(stdate, Date_Sep)(1)
endmon = Split(endate, Date_Sep)(1)
stday = Split(stdate, Date_Sep)(0)
endday = Split(endate, Date_Sep)(0)
styr = Split(stdate, Date_Sep)(2):
endyr = Split(endate, Date_Sep)(2)
Case 2
stmon = Split(stdate, Date_Sep)(1)
endmon = Split(endate, Date_Sep)(1)
stday = Split(stdate, Date_Sep)(2)
endday = Split(endate, Date_Sep)(2)
styr = Split(stdate, Date_Sep)(0)
endyr = Split(endate, Date_Sep)(0)
End Select
' Change the text values we obtained to integers for calculation
' purposes.
stmonf = CInt(stmon)
stdayf = CInt(stday)
styrf = CInt(styr)
' Check for valid date entries.
If stmonf < 1 Or stmonf > 12 Or stdayf < 1 Or stdayf > 31 Or styrf < 1 Then
AgeFunc = "Invalid Date"
Exit Function
End If
' Change the text values we obtained to integers for calculation
' purposes.
endmonf = CInt(endmon)
enddayf = CInt(endday)
endyrf = CInt(endyr)
' Check for valid date entries.
If endmonf < 1 Or endmonf > 12 Or enddayf < 1 Or enddayf > 31 Or endyrf < 1 Then
AgeFunc = "Invalid Date"
Exit Function
End If
' Determine the initial number of years by subtracting the first and
' second year.
years = endyrf - styrf
' Look at the month and day values to make sure a full year has passed.
If stmonf > endmonf Then years = years - 1
End If
If stmonf = endmonf And stdayf > enddayf Then years = years - 1
End If
' Make sure that we are not returning a negative number and, if not,
' return the years.
If years < 0 Then AgeFunc = "Invalid Date" Else AgeFunc = years
End If
End Function

poussebois
 Posté le 02/06/2020 à 08:33 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Maître astucien

Bonjour ,

Oui, une seule instruction par ligne, c'est mieux !

Je te demandais le lien du site où tu avais trouvé cette macro pour voir le contexte. Au lieu de cela, tu envoies la macro sous forme de pavé illisible.

Heureusement qu'on la voit clairement dans la Feuil2 de VBA. En séparant les instructions comme l'a fait Debrief , les lignes rouges disparaissent.

Pour le copié/collé, je viens de vérifier, effectivement, on perd la couleur. Je n'avais jamais fait attention car j'imprime toujours en N&B.

@ +

TJA435
 Posté le 02/06/2020 à 17:28 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

Merci pour vos réponses.

J 'ai envoyé la macro sous la forme que je l' ai trouvée sur internet (refaite par Myta), j' ai essayé de la remettre sous forme lisible et je n' y suis pas arrivé.

Ça marche après vos corrections.

J' ai eu de la peine avec : Date_Fmt = Application.International(xlDateOrder)

Merci pour votre aide.

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
13,79 €Adaptateur USB 3.0 Ethernet Gigabit TP-Link UE300 à 13,79 €
Valable jusqu'au 10 Août

Amazon fait une promotion sur l'adaptateur USB 3.0 Ethernet Gigabit TP-Link UE300 qui passe à 13,79 € au lieu de 20 €. Cet adaptateur vous permettra de rajouter une prise Ethernet Gigabit à votre ordinateur portable (ou votre tablette via un adaptateur OTG) qui en est dépourvu.


> Voir l'offre
66,90 €Kit de 16 Go (2 x 8 Go) de mémoire DDR4 Corsair Vengeance LPX 3200 MHz à 66,90 €
Valable jusqu'au 12 Août

Amazon fait une belle promotion sur le kit de 16 Go (2x8 Go) de mémoire DDR4 Corsair Vengeance LPX 3200 MHz qui passe à 66,90 € livrée gratuitement.


> Voir l'offre
22,69 €Support mural PC / TV 20 à 75 pouces à 22,69 €
Valable jusqu'au 10 Août

Amazon propose actuellement le support mural PC / TV Cheetah Mounts APTMM2B à 22,69 € seulement. Ce support mural est adapté aux écrans plats de 20 à 75 pouces LED, LCD et PLASMA à compatibilité VESA jusqu'à 600x400.  Il supporte jusqu'à 75Kg. Un niveau à bulles ainsi qu'un câble HDMI vous sont même fournis ! 


> Voir l'offre

Sujets relatifs
Les modèles dans Excel 2016
Excel 2016 macro
Anomalie à l'édition dans excel 2016
excel 2016 références circulaires dans une formule fait référence à sa prop
erreur à l'ouverture d'un classeur excel 2016
[Macro XL 2016- Recherche de texte dans classeur]
suite 2016 word dans excel
excel 2016 regroupement dans tableau croisé dynamique (tcd)
excel 2016 macro
une erreur dans ma macro
Plus de sujets relatifs à excel 2016 erreur dans macro
 > Tous les forums > Forum Bureautique