Discussion :

[jeanfra77160]

Bonjour à tous,

Je me présente, François, je suis géologue, je me sers un peu des macro excel en temps habituel mais je n'ai pas une utilisation suffisante pour surmonter un problème qui semblera à certains d'entre vous une broutille...
Je reprend le poste d'une collègue qui à crée la macro afin d'automatiser une tâche assez rébarbative et répétitive, le niveau du code est trop complexe pour moi, aussi j'aimerais bien avoir des explications sur comment celui-ci fonctionne.
Mais le problème que je rencontre aujourd'hui est le suivant : une fonction des différentes macros plante systématiquement : je vous explique le process :

J'ai a la base un fichier excel comme suit :



Il s'agit d'analyses de carottages.
Le but du jeu est de séparer chacun des items hole_id dans un onglet chacun et d'adapter l’épaisseur des échantillons à la largeur de la ligne.
Pour ce faire 3 macro ont été crées par ma prédécesseuse (?) je vous le colle ici dans l'ordre où elles doivent être éxécutées :

CODE 1 : Création feuille

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Option Explicit
 
Sub CreationFeuilles()
Dim J As Long
Dim Ws As Worksheet
 
Sheets("labo").Select
 
  Application.ScreenUpdating = False
  Set Ws = Sheets("labo")
  For J = 1 To Range("D" & Rows.Count).End(xlUp).Row
    If Not ExisteFeuille(Ws.Range("D" & J).Text) Then
      Sheets.Add after:=Sheets(Sheets.Count)
      ActiveSheet.Name = Ws.Range("D" & J)
      Sheets("Modèle").Cells.Copy Destination:=Range("A1")
       ActiveSheet.Cells(4, 5) = Ws.Range("D" & J)
    End If
  Next J
  Sheets("Hole_ID").Select
    ActiveWindow.SelectedSheets.Delete
  Ws.Select
End Sub
 
 
Function ExisteFeuille(Nom As String) As Boolean
  On Error Resume Next
  ExisteFeuille = Sheets(Nom).Name <> ""
  On Error GoTo 0
End Function

CODE 2 : Remplir feuille

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Sub remplir_feuilles()
Dim hole(1000)
Dim Ligne As Long
Dim ld As Long
Dim lf As Long
 
 
 
Ligne = Columns(4).Find("*", , , , xlByColumns, xlPrevious).Row 'dernière ligne remplie de la colonne A
hole(1) = Range("D2") ' code premier hole
 
' LISTAGE DIFFERENTS CODES
x = 1 ' variable pour compter nombre de hole
For n = 3 To Ligne ' boucle sur les lignes depuis la 3eme jusqu'à la dernière
' si code différent du précedent incrementationd e l variable et relevé du code
If Range("D" & n) <> hole(x) Then x = x + 1: hole(x) = Range("D" & n)
Next n
 
'TRAITEMENT DONNEES
' Boucle sur le nombre de codes
For h = 1 To x
' récupère première ligne du code et dernière ligen du code
ld = Columns(4).Find(hole(h), , , xlWhole, xlByColumns, xlNext).Row
lf = Columns(4).Find(hole(h), , , xlWhole, xlByColumns, xlPrevious).Row
 
nomf = hole(h) ' recupère nom du code
' Inscription des données dans la feuille
With Sheets(nomf)
 
ligneT = 8 ' ligne des titres
For y = ld To lf 'boucle sur les lignes du code en Feuil 1
.Range("B" & ligneT + y - ld) = Range("E" & y)
.Range("C" & ligneT + y - ld) = Range("H" & y)
.Range("D" & ligneT + y - ld) = Range("P" & y)
.Range("E" & ligneT + y - ld) = Range("R" & y)
.Range("F" & ligneT + y - ld) = Range("S" & y)
.Range("G" & ligneT + y - ld) = Range("T" & y)
.Range("H" & ligneT + y - ld) = Range("AC" & y)
.Range("I" & ligneT + y - ld) = Range("I" & y)
.Range("J" & ligneT + y - ld) = Range("J" & y)
.Range("K" & ligneT + y - ld) = Range("K" & y)
.Range("L" & ligneT + y - ld) = Range("M" & y)
Next y
 
 
 
End With
 
Next h
End Sub

CODE 3 : boucle feuille

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub bouclefeuille()
'
' Macro1 Macro
'
Dim hgt As Variant
Dim WorkRng As Range
Dim Ws As Worksheet
 
    For Each Ws In Worksheets
        If Ws.Name Like "CG_PE_????" Then
           Ws.Activate
   ' xTxt = ActiveWindow.RangeSelection.Address
   Set WorkRng = Range("C8:C27")
 
For Each h In WorkRng
 
            hgt = h.Value * 500
            h.EntireRow.Select
            Selection.RowHeight = hgt
 
    Next h
'Application.Run "sondages2018Amontre3.xlsm!Boutontest"
 End If
    Next Ws
 
End Sub

Ma problématique est sur cette dernière fonction : elle plante systématiquement sur la ligne "Selection.RowHeight = hgt" et je ne comprend pas pourquoi...

Merci de l'attention que vous avez prêté à mon message et de l'aide que vous voudrez bien me donner =)

Bonne journée à tous

[BENNASR]

bonjour
déclare votre variable en long au lieu de variant et voir ce que ça donne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim hgt As Long

au lieu de

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim hgt As Variant

[BENNASR]

quelle valeur prends cette variable !!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Selection.RowHeight = hgt

qu'est ce que tu cherches à faire !!! ce n'est pas la propriété pour définir la hauteur d'une ligne ???

[Menhir]

Il y a peut-être confusion sur la nature de "Selection".

Remplace :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
hgt = h.Value * 500
h.EntireRow.Select
Selection.RowHeight = hgt

Par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

h.RowHeight = h.Value * 500

Si le problème persiste, il est probable (sans certitude) que la valeur est trop grande pour une hauteur de ligne.
Lorsque ta macro plante, regarde dans la liste des variables locales le contenu de la variable "h" qui représente la cellule en cours de traitement.
Va voir la valeur que contient cette cellule.
A ma connaissance, la hauteur max pour une ligne est 400. Il faut donc que la valeur contenu dans tes cellules soit inférieure à 0,8.

Autre détail : n'oublie pas d'indiquer le message d'erreur qui s'affiche au moment du plantage, ça aide pour identifier le problème.

[jeanfra77160]

Tout d'abord merci pour vos réponses, j'ai appliqué les modifications.

Le code du plantage est :
Erreur d'execution '1004'
Impossible de définir la propriété RowHeight de la classe Range

Menhir, je pense que ton doute ce confirme, je viens de remplacer 500 par 50 et la macro ne plante plus.

Je pense que je peux passer ce sujet en résolu ? Merci encore pour votre aide à tous deux.