CADxp: Macro VBA " métré" - CADxp

Aller au contenu

Page 1 sur 1
  • Vous ne pouvez pas commencer un sujet
  • Vous ne pouvez pas répondre à ce sujet

Macro VBA " métré"

#1 L'utilisateur est hors-ligne   robine 

  • ceinture orange
  • Groupe : Membres
  • Messages : 23
  • Inscrit(e) : 07-juin 07

Posté 18 mars 2019 - 10:52

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

#2 L'utilisateur est hors-ligne   Lommig 

  • ceinture bleue
  • Groupe : Membres
  • Messages : 168
  • Inscrit(e) : 25-juillet 12
  • LocationBretagne

Posté 18 mars 2019 - 13:14

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
0

#3 L'utilisateur est hors-ligne   robine 

  • ceinture orange
  • Groupe : Membres
  • Messages : 23
  • Inscrit(e) : 07-juin 07

Posté 18 mars 2019 - 15:13

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
0

#4 L'utilisateur est hors-ligne   (gile) 

  • ceinture rouge et blanche 8em dan
  • Groupe : Moderateurs
  • Messages : 11158
  • Inscrit(e) : 02-septembre 05

Posté 18 mars 2019 - 17:34

Salut,

As-tu téléchargé et installé le module VBA ?
Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
Image IPB
0

#5 L'utilisateur est hors-ligne   robine 

  • ceinture orange
  • Groupe : Membres
  • Messages : 23
  • Inscrit(e) : 07-juin 07

Posté 18 mars 2019 - 17:41

Voir le message(gile), le 18 mars 2019 - 17:34 , dit :



oui oui
0

#6 L'utilisateur est hors-ligne   Lommig 

  • ceinture bleue
  • Groupe : Membres
  • Messages : 168
  • Inscrit(e) : 25-juillet 12
  • LocationBretagne

Posté 19 mars 2019 - 10:51

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
0

#7 L'utilisateur est hors-ligne   robine 

  • ceinture orange
  • Groupe : Membres
  • Messages : 23
  • Inscrit(e) : 07-juin 07

Posté 22 mars 2019 - 09:43

Voir le messageLommig, le 19 mars 2019 - 10:51 , dit :

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
0

Partager ce sujet :


Page 1 sur 1
  • Vous ne pouvez pas commencer un sujet
  • Vous ne pouvez pas répondre à ce sujet

1 utilisateur(s) en train de lire ce sujet
0 membre(s), 1 invité(s), 0 utilisateur(s) anonyme(s)