Macro VBA " métré"

[robine]

Bonjour à tous,

 

J'ai essayé de réutiliser une macro que j'avais au fond d'un tiroir et qui fonctionnait parfaitement avant.

J'ai un message " erreur de compilation : Projet ou bibliothèque introuvable

Malheureusement mon niveau 0 en VBA ne me permet pas d'identifier et de régler cette erreur ...

 

Pouvez vous m'aider svp ?

Merci :)

[Lommig]

Bonjour,

 

Tu exécutes ton projet VBA dans AutoCAD ?

Quelle est ta version d'AutoCAD ?

Peux-tu nous transmettre ton projet VBA (fichier .DVB pour AutoCAD) ?

Ton projet VBA utilise Excel ?

 

Guillaume

[robine]

Tu exécutes ton projet VBA dans AutoCAD ? oui

Quelle est ta version d'AutoCAD ? Autocad 2018

Peux-tu nous transmettre ton projet VBA (fichier .DVB pour AutoCAD) ?

Ton projet VBA utilise Excel ? oui

 

Je n'arrive pas a le mettre en PJ (pb d'erreur du serveur), alors le voici :

 

 

Sub Métrés()

 

 

Dim i, j, NbrBlocs, NbrPlignes, NbrLwPlines, NbrObjets As Double

Dim Largeur, Echelle, Couleur, Nbr, Longueur, Surface As Variant

Dim NomCalque, NomObjet, NomBloc, TypeTrait As String

Dim Bloc As AcadBlockReference

Dim L() As Variant

Dim objet As AcadObject

Dim Selection As AcadSelectionSet

Dim Coord As Variant

On Error Resume Next

ThisDrawing.SelectionSets("SEL").Delete

Set Selection = ThisDrawing.SelectionSets.Add("SEL")

Selection.SelectOnScreen

 

NbrObjets = Selection.Count

ReDim L(NbrObjets, 10)

L(0, 1) = 0

 

For Each objet In Selection

 

NomCalque = objet.Layer

If Len(NomCalque) = 1 Then NomCalque = "Layer " & NomCalque

NomObjet = objet.ObjectName

 

 

If NomObjet = "AcDbBlockReference" Then

NomObjet = "Bloc"

Set Bloc = objet

NomBloc = Bloc.Name

If Left(NomBloc, 1) <> "*" Then

j = L(0, 1) + 1

For i = 1 To j

If L(i, 0) = "" Then L(0, 1) = L(0, 1) + 1

If (L(i, 0) = "" Or (L(i, 0) = NomCalque And L(i, 1) = NomObjet And L(i, 2) = NomBloc)) Then

L(i, 0) = NomCalque: L(i, 1) = NomObjet: L(i, 2) = NomBloc

L(i, 7) = L(i, 7) + 1

i = j

End If

 

Next i

End If

End If

 

If NomObjet = "AcDbBlock" Then

NomObjet = "Bloc"

Set Bloc = objet

NomBloc = Bloc.Name

If Left(NomBloc, 1) <> "*" Then

j = L(0, 1) + 1

For i = 1 To j

If L(i, 0) = "" Then L(0, 1) = L(0, 1) + 1

If (L(i, 0) = "" Or (L(i, 0) = NomCalque And L(i, 1) = NomObjet And L(i, 2) = NomBloc)) Then

L(i, 0) = NomCalque: L(i, 1) = NomObjet: L(i, 2) = NomBloc

L(i, 7) = L(i, 7) + 1

i = j

End If

 

Next i

End If

End If

 

If NomObjet = "AcDbLWPolyline" Then

NomObjet = "Pline"

NomBloc = ""

TypeTrait = objet.Linetype

Largeur = objet.Lineweight

Echelle = objet.LinetypeScale

Couleur = objet.color

Longueur = objet.Length

 

If objet.Closed Then Surface = objet.Area Else Surface = 0

j = L(0, 1) + 1

For i = 1 To j

If L(i, 0) = "" Then L(0, 1) = L(0, 1) + 1

If (L(i, 0) = "" Or (L(i, 0) = NomCalque And L(i, 1) = NomObjet And L(i, 3) = TypeTrait And L(i, 4) = Largeur And L(i, 5) = Echelle And L(i, 6) = Couleur)) Then

L(i, 0) = NomCalque: L(i, 1) = NomObjet: L(i, 3) = TypeTrait

L(i, 4) = Largeur: L(i, 5) = Echelle: L(i, 6) = Couleur

L(i, 7) = L(i, 7) + 1: L(i, 8) = L(i, 8) + Longueur: L(i, 9) = L(i, 9) + Surface

If Surface <> 0 Then L(i, 10) = L(i, 10) + 1

i = j

End If

Next i

End If

 

If NomObjet = "AcDbPolyline" Then

NomBloc = ""

NomObjet = "Pline"

TypeTrait = objet.Linetype

Largeur = objet.ConstantWidth

Echelle = objet.LinetypeScale

Couleur = objet.color

Longueur = objet.Length

 

Surface = objet.Area

If objet.Closed Then Surface = objet.Area Else Surface = 0

j = L(0, 1) + 1

For i = 1 To j

If L(i, 0) = "" Then L(0, 1) = L(0, 1) + 1

If (L(i, 0) = "" Or (L(i, 0) = NomCalque And L(i, 1) = NomObjet And L(i, 3) = TypeTrait And L(i, 4) = Largeur And L(i, 5) = Echelle And L(i, 6) = Couleur)) Then

L(i, 0) = NomCalque: L(i, 1) = NomObjet: L(i, 3) = TypeTrait

L(i, 4) = Largeur: L(i, 5) = Echelle: L(i, 6) = Couleur

L(i, 7) = L(i, 7) + 1: L(i, 8) = L(i, 8) + Longueur: L(i, 9) = L(i, 9) + Surface

If Surface <> 0 Then L(i, 10) = L(i, 10) + 1

 

i = j

End If

Next i

End If

 

If NomObjet = "AcDb2dPolyline" Then

NomBloc = ""

NomObjet = "SpLine"

TypeTrait = objet.Linetype

Largeur = objet.ConstantWidth

Echelle = objet.LinetypeScale

Couleur = objet.color

Longueur = objet.Length

If objet.Closed Then Surface = objet.Area Else Surface = 0

j = L(0, 1) + 1

For i = 1 To j

If L(i, 0) = "" Then L(0, 1) = L(0, 1) + 1

If (L(i, 0) = "" Or (L(i, 0) = NomCalque And L(i, 1) = NomObjet And L(i, 3) = TypeTrait And L(i, 4) = Largeur And L(i, 5) = Echelle And L(i, 6) = Couleur)) Then

L(i, 0) = NomCalque: L(i, 1) = NomObjet: L(i, 3) = TypeTrait

L(i, 4) = Largeur: L(i, 5) = Echelle: L(i, 6) = Couleur

L(i, 7) = L(i, 7) + 1: L(i, 8) = L(i, 8) + Longueur: L(i, 9) = L(i, 9) + Surface

If Surface <> 0 Then L(i, 10) = L(i, 10) + 1

 

i = j

End If

Next i

End If

 

If NomObjet = "AcDbMline" Then

NomBloc = ""

NomObjet = "MLine"

TypeTrait = objet.Linetype

Largeur = objet.ConstantWidth

Echelle = objet.LinetypeScale

Couleur = objet.color

Longueur = objet.Length

If objet.Closed Then Surface = objet.Area Else Surface = 0

j = L(0, 1) + 1

For i = 1 To j

If L(i, 0) = "" Then L(0, 1) = L(0, 1) + 1

If (L(i, 0) = "" Or (L(i, 0) = NomCalque And L(i, 1) = NomObjet And L(i, 3) = TypeTrait And L(i, 4) = Largeur And L(i, 5) = Echelle And L(i, 6) = Couleur)) Then

L(i, 0) = NomCalque: L(i, 1) = NomObjet: L(i, 3) = TypeTrait

L(i, 4) = Largeur: L(i, 5) = Echelle: L(i, 6) = Couleur

L(i, 7) = L(i, 7) + 1: L(i, 8) = L(i, 8) + Longueur

'L(i, 9) = L(i, 9) + Surface

'If Surface <> 0 Then L(i, 10) = L(i, 10) + 1

 

i = j

End If

Next i

End If

 

If NomObjet = "AcDbCircle" Then

NomBloc = ""

NomObjet = "Cercle"

TypeTrait = objet.Linetype

Largeur = objet.ConstantWidth

Echelle = objet.LinetypeScale

Couleur = objet.color

Longueur = objet.Length

Surface = objet.Area

j = L(0, 1) + 1

For i = 1 To j

If L(i, 0) = "" Then L(0, 1) = L(0, 1) + 1

If (L(i, 0) = "" Or (L(i, 0) = NomCalque And L(i, 1) = NomObjet And L(i, 3) = TypeTrait And L(i, 4) = Largeur And L(i, 5) = Echelle And L(i, 6) = Couleur)) Then

L(i, 0) = NomCalque: L(i, 1) = NomObjet: L(i, 3) = TypeTrait

L(i, 4) = Largeur: L(i, 5) = Echelle: L(i, 6) = Couleur

L(i, 7) = L(i, 7) + 1: L(i, 8) = L(i, 8) + Longueur: L(i, 9) = L(i, 9) + Surface

 

i = j

End If

Next i

End If

 

If NomObjet = "AcDbArc" Then

NomBloc = ""

NomObjet = "Arc"

TypeTrait = objet.Linetype

Largeur = objet.ConstantWidth

Echelle = objet.LinetypeScale

Couleur = objet.color

Longueur = objet.Length

Surface = objet.Area

j = L(0, 1) + 1

For i = 1 To j

If L(i, 0) = "" Then L(0, 1) = L(0, 1) + 1

If (L(i, 0) = "" Or (L(i, 0) = NomCalque And L(i, 1) = NomObjet And L(i, 3) = TypeTrait And L(i, 4) = Largeur And L(i, 5) = Echelle And L(i, 6) = Couleur)) Then

L(i, 0) = NomCalque: L(i, 1) = NomObjet: L(i, 3) = TypeTrait

L(i, 4) = Largeur: L(i, 5) = Echelle: L(i, 6) = Couleur

L(i, 7) = L(i, 7) + 1: L(i, 8) = L(i, 8) + Longueur: L(i, 9) = L(i, 9) + Surface

 

i = j

End If

Next i

End If

 

If NomObjet = "AcDbEllipse" Then

NomBloc = ""

NomObjet = "Ellipse"

TypeTrait = objet.Linetype

Largeur = objet.ConstantWidth

Echelle = objet.LinetypeScale

Couleur = objet.color

Longueur = objet.Length

Surface = objet.Area

j = L(0, 1) + 1

For i = 1 To j

If L(i, 0) = "" Then L(0, 1) = L(0, 1) + 1

If (L(i, 0) = "" Or (L(i, 0) = NomCalque And L(i, 1) = NomObjet And L(i, 3) = TypeTrait And L(i, 4) = Largeur And L(i, 5) = Echelle And L(i, 6) = Couleur)) Then

L(i, 0) = NomCalque: L(i, 1) = NomObjet: L(i, 3) = TypeTrait

L(i, 4) = Largeur: L(i, 5) = Echelle: L(i, 6) = Couleur

L(i, 7) = L(i, 7) + 1: L(i, 8) = L(i, 8) + Longueur: L(i, 9) = L(i, 9) + Surface

 

i = j

End If

Next i

End If

 

 

If NomObjet = "AcDbLine" Then

NomBloc = ""

TypeTrait = objet.Linetype

Largeur = objet.Lineweight

Echelle = objet.LinetypeScale

Couleur = objet.color

Longueur = objet.Length

Surface = 0

j = L(0, 1) + 1

For i = 1 To j

If L(i, 0) = "" Then L(0, 1) = L(0, 1) + 1

If (L(i, 0) = "" Or (L(i, 0) = NomCalque And L(i, 1) = "Line" And L(i, 3) = TypeTrait And L(i, 4) = Largeur And L(i, 5) = Echelle And L(i, 6) = Couleur)) Then

L(i, 0) = NomCalque: L(i, 1) = "Line": L(i, 3) = TypeTrait

L(i, 4) = Largeur: L(i, 5) = Echelle: L(i, 6) = Couleur

L(i, 7) = L(i, 7) + 1: L(i, 8) = L(i, 8) + Longueur

i = j

End If

Next i

End If

 

If NomObjet = "AcDbAlignedDimension" Then

NomBloc = objet.TextPrefix

TypeTrait = objet.Linetype

Largeur = objet.Lineweight / 100

Echelle = objet.LinetypeScale

Couleur = objet.color

Longueur = objet.Measurement

Surface = 0

j = L(0, 1) + 1

For i = 1 To j

If L(i, 0) = "" Then L(0, 1) = L(0, 1) + 1

If (L(i, 0) = "" Or (L(i, 0) = NomCalque And L(i, 1) = "Cote" And L(i, 2) = NomBloc And L(i, 3) = TypeTrait And L(i, 4) = Largeur And L(i, 5) = Echelle And L(i, 6) = Couleur)) Then

L(i, 0) = NomCalque: L(i, 1) = "Cote": L(i, 2) = NomBloc: L(i, 3) = TypeTrait

L(i, 4) = Largeur: L(i, 5) = Echelle: L(i, 6) = Couleur

L(i, 7) = L(i, 7) + 1: L(i, 8) = L(i, 8) + Longueur: L(i, 9) = L(i, 9) + Surface

If Surface <> 0 Then L(i, 10) = L(i, 10) + 1

i = j

End If

Next i

End If

 

 

If NomObjet = "AcDbHatch" Then

NomBloc = ""

TypeTrait = objet.PatternName

Largeur = objet.Lineweight

Echelle = objet.PatternScale

Couleur = objet.color

Longueur = 0

Surface = 0

j = L(0, 1) + 1

For i = 1 To j

If L(i, 0) = "" Then L(0, 1) = L(0, 1) + 1

If (L(i, 0) = "" Or (L(i, 0) = NomCalque And L(i, 1) = "Hachure" And L(i, 3) = TypeTrait And L(i, 4) = Largeur And L(i, 5) = Echelle And L(i, 6) = Couleur)) Then

L(i, 0) = NomCalque: L(i, 1) = "Hachure": L(i, 3) = TypeTrait

L(i, 4) = Largeur: L(i, 5) = Echelle: L(i, 6) = Couleur

L(i, 7) = L(i, 7) + 1: L(i, 9) = L(i, 9) + Surface

If Surface <> 0 Then L(i, 10) = L(i, 10) + 1

i = j

End If

Next i

End If

Next

 

Set xl = CreateObject("Excel.Application")

xl.Visible = True

Set Classeur = xl.workbooks.Add

Set feuille = xl.worksheets(1)

feuille.Name = "métrés"

With feuille.Range("A1:K1")

.Font.Name = "Arial"

.Font.Size = 10

.Font.Bold = True

End With

With feuille.cells(1, 1)

.Value = "Nom" & vbLf & "Couche"

End With

feuille.cells(1, 2) = "Nom" & vbLf & "Objet"

feuille.cells(1, 3) = "Nom" & vbLf & "Bloc"

feuille.cells(1, 4) = "Type" & vbLf & "Trait"

feuille.cells(1, 5) = "Largeur"

feuille.cells(1, 6) = "Echelle"

feuille.cells(1, 7) = "Couleur"

feuille.cells(1, 8) = "Nombre" & vbLf & "Total"

feuille.cells(1, 9) = "Longueur" & vbLf & "Totale"

feuille.cells(1, 10) = "Surface" & vbLf & "Totale"

feuille.cells(1, 11) = "Contrôle" & vbLf & "Surface"

 

For i = 1 To L(0, 1)

For j = 0 To 10

feuille.cells(i + 1, j + 1) = L(i, j)

Next j

Next i

 

End Sub

[(gile)]

Salut,

 

As-tu téléchargé et installé le module VBA ?

[robine]

Salut,

 

As-tu téléchargé et installé le module VBA ?

 

oui oui

[Lommig]

Bonjour,

 

 

Peux-tu essayer de joindre ton projet par une plate-forme de téléchargement (DropBox, WeTransfert, OneDrive, Google Drive, GrosFichiers, ...) ?

Je pense qu'il s'agit d'un problème de référence à la bibliothèque Excel (pb assez courant).

Je te demande de suivre la procédure suivante :

- Ouvrir l'éditeur VBA (pour afficher le code VBA)

- Aller dans le menu Outils > Références

- Nous transmettre une copie d'écran des références à ton projet.

 

Guillaume

[robine]

Bonjour,

 

 

Peux-tu essayer de joindre ton projet par une plate-forme de téléchargement (DropBox, WeTransfert, OneDrive, Google Drive, GrosFichiers, ...) ?

Je pense qu'il s'agit d'un problème de référence à la bibliothèque Excel (pb assez courant).

Je te demande de suivre la procédure suivante :

- Ouvrir l'éditeur VBA (pour afficher le code VBA)

- Aller dans le menu Outils > Références

- Nous transmettre une copie d'écran des références à ton projet.

 

Guillaume

 

Voila le lien (le fichier dvb et la copie d'écran) :

 

https://we.tl/t-5ixQ829nUo