Aller au contenu

Macro VBA " métré"


robine

Messages recommandés

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 :)

Lien vers le commentaire
Partager sur d’autres sites

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

AutoCAD, AutoCAD Map3D, AutoCAD Architecture, Revit, COVADIS, InfraWorks 360, ReCap 360, ...

BIM Infrastructure

Lien vers le commentaire
Partager sur d’autres sites

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

Lien vers le commentaire
Partager sur d’autres sites

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

AutoCAD, AutoCAD Map3D, AutoCAD Architecture, Revit, COVADIS, InfraWorks 360, ReCap 360, ...

BIM Infrastructure

Lien vers le commentaire
Partager sur d’autres sites

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

Lien vers le commentaire
Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité