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