× 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
229,99 €Disque dur externe Seagate Backup Plus Hub 10 To USB 3.0 à 229,99 €
Valable jusqu'au 07 Juillet

Amazon propose actuellement le disque dur externe Seagate 10 To Backup Plus Hub USB 3.0 à 229,99 € livré gratuitement. On le trouve ailleurs à partir de 300 €. Grâce à la connectique USB 3.0 (compatible USB 2.0), ce disque dur vous offrira d'excellents débits pour vos transferts et vos sauvegardes. Doté de deux ports USB intégrés en façade, ce disque vous permet de sauvegarder vos fichiers, ainsi que vos photos et vidéos, tout en parcourant et en rechargeant votre tablette, smartphone ou appareil photo, même si votre système est éteint ou en veille.


> Voir l'offre
14,49 €Ventilateur USB ARCTIC Breeze France à 14,49 € livré
Valable jusqu'au 05 Juillet

Amazon fait une belle promotion sur le ventilateur USB ARCTIC Breeze paré aux couleurs françaises à 9,99 €. Comptez 4,50 € pour la livraison en France soit un total de 14,49 € livré alors qu'on le trouve habituellement à plus de 20 €.  Ce ventilateur peut être branché sur n'importe quel ordinateur via une prise USB (câble de 1,8 m) ou bien directement sur une alimentation USB ou une batterie portable et vous procure une brise légère durant les jours chauds. Le cou flexible du ventilateur USB peut être plié dans n'importe quelle direction. La vitesse peut être réglée en continu à l'aide du bouton sur le pied qui est en acier et bien stable sur toutes les surfaces.


> Voir l'offre
393,26 €Ecran ultra large LG 34 pouces 34GL750 (UWFHD, 144 Hz, HDR10, 1 ms) à 393,26 € livré
Valable jusqu'au 05 Juillet

Amazon Allemagne propose actuellement l'écran 34 pouces LG 34GL750 à 372,56 €. Comptez 20,70 € pour la livraison en France soit un total de 393,26 € livré alors qu'on le trouve à partir de 500 € ailleurs. Cet écran ultra large est au format 21/9, possède une dalle IPS HDR10 144 Hz et offre une résolution de 2560 x 1080 pixels. Avec lui, vous pourrez bénéficier d'une plus grande immersion dans les jeux et les films. Cet écran est compatible FreeSync et Gsync via Adaptive Sync.

Vous pouvez utiliser votre compte Amazon France sur Amazon Allemagne et il n'y a pas de douane.


> 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