AW: An Manuela M
24.11.2003 13:36:40
Reinhard
Hi Ilka,
tausche bitte diese 2 Zeilen:
AnzahlBreite = WorksheetFunction.RoundUp(Raumbreite / (Fliesenbreite + Fuge), 0)
AnzahlLänge = WorksheetFunction.RoundUp(Raumlänge / (Fliesenlänge + Fuge), 0)
gegen das Folgende aus.
AnzahlLänge = 1
While (AnzahlLänge * ws.[d3] * 10 + (AnzahlLänge + 1) * ws.[e3]) < ws.[b3] * 1000
AnzahlLänge = AnzahlLänge + 1
Wend
AnzahlBreite = 1
While (AnzahlBreite * ws.[c3] * 10 + (AnzahlBreite + 1) * ws.[e3]) < ws.[a3] * 1000
AnzahlBreite = AnzahlBreite + 1
Wend
Gruß
Reinhard
ps: für alle Interessierte, darum gehts:
A B C D E
Raum Fliese Fuge
Breite Länge Breite Länge Breite
1,06m 1,57m 20,00cm 25,00cm 10,00 mm
Länge
6
Breite
5
Fliesen
30
Option Explicit
Dim ws As Worksheet, Raumbreite As Double, Raumlänge As Double
Dim Fliesenbreite As Double, Fliesenlänge As Double
Dim links As Double, oben As Double
Dim Restbreite As Double, Restlänge As Double, Fuge As Double
Dim bolGrundfläche As Boolean, bolFliesen As Boolean
Const MASSSTAB As Double = 2
Sub Grundfläche()
If bolGrundfläche Then Exit Sub
Dim Sh As Shape
Call setten
Raumbreite = ws.[a3] * 100 * MASSSTAB
Raumlänge = ws.[b3] * 100 * MASSSTAB
ws.[a5] = 0
ws.[a7] = 0
ws.[a9] = 0
links = 50
oben = 50
Set Sh = ActiveSheet.Shapes.AddShape(msoShapeRectangle, links, oben, Raumlänge, Raumbreite)
With Sh
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.SchemeColor = 22
.Line.Visible = msoFalse
End With
bolGrundfläche = True
End Sub
Sub Fliesen()
If Not bolGrundfläche Then Exit Sub
If bolFliesen Then Exit Sub
Dim Sh As Shape, AnzahlBreite As Double, AnzahlLänge As Double, fv As Long, fh As Long
Call setten
Fliesenbreite = ws.[c3] * MASSSTAB
Fliesenlänge = ws.[d3] * MASSSTAB
Fuge = (ws.[e3] / 10) * MASSSTAB
'MsgBox Fuge
'Exit Sub
'AnzahlBreite = WorksheetFunction.RoundUp(Raumbreite / (Fliesenbreite + Fuge), 0)
'AnzahlLänge = WorksheetFunction.RoundUp(Raumlänge / (Fliesenlänge + Fuge), 0)
AnzahlLänge = 1
While (AnzahlLänge * ws.[d3] * 10 + (AnzahlLänge + 1) * ws.[e3]) < ws.[b3] * 1000
AnzahlLänge = AnzahlLänge + 1
Wend
AnzahlBreite = 1
While (AnzahlBreite * ws.[c3] * 10 + (AnzahlBreite + 1) * ws.[e3]) < ws.[a3] * 1000
AnzahlBreite = AnzahlBreite + 1
Wend
ws.[a5] = AnzahlLänge
ws.[a7] = AnzahlBreite
ws.[a9] = AnzahlLänge * AnzahlBreite
links = 50 + Fuge
oben = 50 + Fuge
Application.ScreenUpdating = False
For fh = 1 To AnzahlBreite
For fv = 1 To AnzahlLänge
Set Sh = ActiveSheet.Shapes.AddShape(msoShapeRectangle, links, oben, Fliesenlänge, Fliesenbreite)
Sh.Fill.PresetTextured 13
Sh.Line.Visible = msoFalse
links = links + (Fuge + Fliesenlänge)
Next
links = 50 + Fuge
oben = oben + (Fuge + Fliesenbreite)
Next
Application.ScreenUpdating = True
bolFliesen = True
End Sub
Sub löschen()
Dim Sh As Shape
Call setten
For Each Sh In ws.Shapes
If Sh.Type = 1 Then Sh.Delete
Next
bolFliesen = False
bolGrundfläche = False
End Sub
Private Sub setten()
If ws Is Nothing Then Set ws = Sheets("Fliesen")
End Sub