Plans maisons

[SYL'S]

Salut le forum,

Il y a un an, je me posais la question : est-il possible de faire des plans (de maisons dans mon cas) avec Excel ?

Par exemple : définition d’un nom pour une porte (zone de cellules) puis copier/coller de cet porte sur une ligne/cloison…. Une couleur de cellule (par exe : vert) pour une cuisine puis calcul automatique de la surface de celle-ci selon le nombre de cellule verte …

Mais à l’époque, j’ai buté sur le problème d’échelle d’une cellule de 10cm par 10cm et comme les valeurs sont en points. ??? j’ai abandonné rapidement

Quand je vois ce que vous faites sur ce site, je me repose et vous pose mes interrogations.

Est ce que vous connaissez déjà ce qui a pu être fait dans ce domaine ? est ce que mon projet est surréaliste ?

Merci et bonne soirée.

 

[jipi]

une fois j'ai trouvé ça, peut-etre interressant
trop compliqué pour moi

Attribute VB_Name = "LignesColonnesEnCentimetres"

'code Microsoft
'The following Visual Basic for Applications procedures allow you to specify the
'row and column widths in centimeters:

Sub RowHeightInCentimeters()
Dim cm As Integer
' Get the row height in centimeters.
cm = Application.InputBox("Enter Row Height in Centimeters", _
"Row Height (cm)", Type:=1)
' If cancel button not pressed and a value entered.
If cm Then
' Convert and set the row height
Selection.RowHeight = Application.CentimetersToPoints(cm)
End If
End Sub

Sub ColumnWidthInCentimeters()

Dim cm As Integer, points As Integer, savewidth As Integer
Dim lowerwidth As Integer, upwidth As Integer, curwidth As Integer
Dim Count As Integer

' Turn screen updating off.
Application.ScreenUpdating = False
' Ask for the width in inches wanted.
cm = Application.InputBox("Enter Column Width in Centimeters", _
"Column Width (cm)", Type:=1)
' If cancel button for the input box was pressed, exit procedure.
If cm = False Then Exit Sub
' Convert the inches entered to points.
points = Application.CentimetersToPoints(cm)
' Save the current column width setting.
savewidth = ActiveCell.ColumnWidth
' Set the column width to the maximum allowed.
ActiveCell.ColumnWidth = 255
' If the points desired is greater than the points for 255
' characters...
If points > ActiveCell.Width Then
' Display a message box because the size specified is too
' large and give the maximum allowed value.
MsgBox "Width of " & cm & " is too large." & Chr(10) & _
"The maximum value is " & _
Format(ActiveCell.Width / 28.3464566929134, _
"0.00"), vbOKOnly + vbExclamation, "Width Error"
' Reset the column width back to the original.
ActiveCell.ColumnWidth = savewidth
' Exit the Sub.
Exit Sub
End If
' Set the lowerwidth and upper width variables.
lowerwidth = 0
upwidth = 255
' Set the column width to the middle of the allowed character
' range.
ActiveCell.ColumnWidth = 127.5
curwidth = ActiveCell.ColumnWidth
' Set the count to 0 so if it can't find an exact match it won't
' go on indefinitely.
Count = 0
' Loop as long as the cell width in is different from width
' wanted and the count (iterations) of the loop is less than 20.
While (ActiveCell.Width <> points) And (Count < 20)
' If active cell width is less than desired cell width.
If ActiveCell.Width < points Then
' Reset lower width to current width.
lowerwidth = curwidth
' set current column width to the midpoint of curwidth
' and upwidth.
Selection.ColumnWidth = (curwidth + upwidth) / 2
' If active cell width is greater than desired cell width.
Else
' Set upwidth to the curwidth.
upwidth = curwidth
' Set column width to the mid point of curwidth and lower
' width.
Selection.ColumnWidth = (curwidth + lowerwidth) / 2
End If
' Set curwidth to the width of the column now.
curwidth = ActiveCell.ColumnWidth
' Increment the count counter.
Count = Count + 1
Wend
End Sub

 

[SYL'S]

Salut jipi et le forum,

génial ton vba !!! je viens de faire un test , il y a quelques réglages à faire car à la sortie 1cm en colonne n'est pas égale au 1cm ligne??? mais ça doit être facilement règlable.

je te remercie énormément. Syl's

 

[gepeto]

ça m'interresse bigrement aussi
si tu arrives à paufiner le réglages, redonnes nous le code

merci
@+

 

[SYL'S]

Salut Gepeto,

laisse moi un peu de temps, c'est pas si simple que celà...le vba m'est inconnu...et il faut que j'essaie en dessous du 1cm ???

A plus tard. Syl's

 

[gepeto]

j'ai trouvé ça ds mes archives
je crois que ça marche
et bcp plus simple

tu colles le codes ds une feuill
tu selectionnes une plage
et tu executes la macro
en mettant 10mm ds la boite



Sub FaireCarreEnmm()
Dim WPChar As Double
Dim DInch As Double
Dim Temp As String

Temp = InputBox("Hauteur,largeur en mm?")
DInch = Val(Temp) / 25.4
If DInch > 0 And DInch < 2.5 Then
i = 0
For Each col In ActiveWindow.RangeSelection.Columns
i = i + 1
If i = 1 Then
col.EntireColumn.AutoFit
WPChar = col.Width / col.ColumnWidth
End If
col.ColumnWidth = ((DInch * 72) / WPChar)
Next col
For Each lig In ActiveWindow.RangeSelection.Rows
lig.RowHeight = (DInch * 72)
Next lig
End If
End Sub

 

[SYL'S]

salut Gepeto Trouve-tout !!!

C'est au poil, je dirait même au millimêtre ))

mais j'ai toujours ce problême à l'impression de différence entre les lignes et les colonnes, en fin de compte ça doit venir de mon imprimante ???

tant qu'il en soit un très grand merci à jipi et gépéto et les autres...je vais pouvoir commencer à réaliser mon excel-plans d'architecture grâce à vous !!! peut être téléchargeable bientôt !!!

EXCELLEMENT VOTRE.

 

[gepeto]

tiens moi courrant
suis interressé par tout ce qui a un rapport avec le dessin

merci
@+

 

[SYL'S]

Pas de problème.

tu es dans quel domaine ?

 

[gepeto]

S.I.G
appris sur le tas
et en apprends tjrs

@+