× 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
9,99 €Adaptateur Bluetooth USB TP-Link UB400 à 9,99 €
Valable jusqu'au 15 Août

Amazon fait une promotion sur l'adaptateur Bluetooth USB TP-Link UB400 qui passe à 9,99 €. Cet adaptateur à brancher sur un port USB va vous permettre d'ajouter le bluetooth à votre ordinateur et d'utiliser ensuite sans fil vos périphériques bluetooth : souris, clavier, casque, manette, téléphone, ...


> Voir l'offre
104,43 €SSD Crucial MX500 1 To à 104,43 € livré
Valable jusqu'au 16 Août

Amazon Allemagne propose actuellement le SSD Crucial MX500 1 To à 99,84 € (avec la TVA ajustée). Comptez 4,60 € pour la livraison en France soit un total de 104,43 € livré. On le trouve ailleurs à partir de 130 €. Ce SSD salué par la critique par son rapport qualité prix imbattable offre des débits de 560 Mo/s en lecture et 510 Mo/s en écriture. Il est garanti 5 ans. 

Vous pouvez utiliser votre compte Amazon France sur Amazon Allemagne et il n'y a pas de douanes. Si vous êtes perdu en allemand, vous pouvez traduire le site en anglais.


> Voir l'offre
149,99 €Ecran 24 pouces ViewSonic VX2458-C-MHD (incurvé, FullHD, 144Hz, 1ms) à 149,99 €
Valable jusqu'au 14 Août

Darty fait une promotion sur l'écran 24 pouces ViewSonic VX2458-C-MHD qui passe à 149,99 €. On le trouve ailleurs à partir de 170 €. Cet écran dédié aux joueurs dispose d'une dalle incurvée FullHD 1 ms à 144 Hz, un filtre lumière bleue et de la technologie anti scintillement Flicker Free. Il est compatible FreeSync, GSync et a des entrées HDMI, DP et DVI. Il intègre des haut-parleurs. 


> 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