Upon creating the Macro & when I ran it it showed a ( compile error-syntex
error)
(( .Width = .Width * .Width / (Selection.Width - x2 * 2) *
Screen_Width / Printer_Width
.Height = .Height * .Height / (Selection.Height - y2 * 2) *
Screen_Height / Printer_Height))
Regards
Snbahri

"damorrison" wrote:

Here's a macro I have found that puts a ruler on a spreadsheet, by now
meens a cad but maybe it will help

'Ruler for Excel(Centimeter)

Sub MakeRuler_cm()

'Define the size of a new ruler.
Const Ruler_Width As Double = 16 'Width 16 cm
Const Ruler_Height As Double = 14 'Height 14 cm

'The setting size on the screen and the actual size on the printer.
Const Screen_Width As Double = 16
Const Screen_Height As Double = 14
Const Printer_Width As Double = 16
Const Printer_Height As Double = 14

Dim i As Long
Dim l As Long
Dim x As Long
Dim y As Long
Dim ws As Worksheet
Dim x2 As Double
Dim y2 As Double

x = Ruler_Width * 10
y = Ruler_Height * 10

Application.ScreenUpdating = False

Set ws = ActiveSheet
Worksheets.Add
ActiveSheet.Move
ActiveSheet.Lines.Add 0, 0, 3 * x, 0
For i = 1 To x
If i Mod 10 = 0 Then l = 5 Else: If i Mod 5 = 0 Then l = 4 Else
l = 3
ActiveSheet.Lines.Add 3 * i, 0, 3 * i, 3 * l
Next
ActiveSheet.Lines.Add 0, 0, 0, 3 * y
For i = 1 To y
If i Mod 10 = 0 Then l = 5 Else: If i Mod 5 = 0 Then l = 4 Else
l = 3
ActiveSheet.Lines.Add 0, 3 * i, 3 * l, 3 * i
Next
ActiveSheet.Lines.Border.ColorIndex = 55

For i = 10 To x - 1 Step 10
With ActiveSheet.TextBoxes.Add(3 * i - 9, 3 * 5, 18, 12)
.Text = Format(i \ 10, "!@@")
End With
Next
For i = 10 To y - 1 Step 10
With ActiveSheet.TextBoxes.Add(3 * 5, 3 * i - 9, 12, 18)
.Orientation = xlDownward
.Text = Format(i \ 10, "!@@")
End With
Next
With ActiveSheet.TextBoxes
.Font.Size = 9
.Font.ColorIndex = 55
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Border.ColorIndex = xlNone
.Interior.ColorIndex = xlNone
End With

With ActiveSheet.DrawingObjects.Group
.Placement = xlFreeFloating
.Width = Application.CentimetersToPoints(x / 10)
.Height = Application.CentimetersToPoints(y / 10)
.CopyPicture xlScreen, xlPicture
ActiveSheet.Paste
x2 = (Selection.Width - .Width) / 3
y2 = (Selection.Height - .Height) / 3
Selection.Delete
.CopyPicture xlPrinter, xlPicture
ActiveSheet.Paste
.Width = .Width * .Width / (Selection.Width - x2 * 2) *
Screen_Width / Printer_Width
.Height = .Height * .Height / (Selection.Height - y2 * 2) *
Screen_Height / Printer_Height
Selection.Delete
If Val(Application.Version) = 9 Then
.Copy
ActiveSheet.PasteSpecial 'Format:="Picture (PNG)"
With Selection.ShapeRange.PictureFormat
.CropLeft = x2
.CropTop = y2
.CropRight = x2
.CropBottom = y2
End With
Selection.Copy
ws.Activate
ws.PasteSpecial 'Format:="Picture (PNG)"
Selection.Placement = xlFreeFloating
.Parent.Parent.Close False
End If
End With
Application.ScreenUpdating = True
End Sub

Sub MakeRuler_inch()

'Define the size of a new ruler.
Const Ruler_Width As Double = 6 'Width 6 inch
Const Ruler_Height As Double = 5 'Height 5 inch

'The setting size on the screen and the actual size on the printer.
Const Screen_Width As Double = 6
Const Screen_Height As Double = 5
Const Printer_Width As Double = 6
Const Printer_Height As Double = 5

Dim i As Long
Dim l As Double
Dim x As Long
Dim y As Long
Dim ws As Worksheet
Dim a(0 To 15) As Double
Dim x2 As Double
Dim y2 As Double

x = Ruler_Width * 16
y = Ruler_Height * 16
a(0) = 3.6: a(1) = 1: a(2) = 2: a(3) = 1: a(4) = 2: a(5) = 1: a(6)
= 2: a(7) = 1
a(8) = 3: a(9) = 1: a(10) = 2: a(11) = 1: a(12) = 2: a(13) = 1:
a(14) = 2: a(15) = 1
Application.ScreenUpdating = False

Set ws = ActiveSheet
Worksheets.Add
ActiveSheet.Move
ActiveSheet.Lines.Add 0, 0, 3 * x, 0
For i = 1 To x
l = a(i Mod 16)
ActiveSheet.Lines.Add 3 * i, 0, 3 * i, 3 * l
Next
ActiveSheet.Lines.Add 0, 0, 0, 3 * y
For i = 1 To y
l = a(i Mod 16)
ActiveSheet.Lines.Add 0, 3 * i, 3 * l, 3 * i
Next
ActiveSheet.Lines.Border.ColorIndex = 55

For i = 16 To x - 1 Step 16
With ActiveSheet.TextBoxes.Add(3 * i - 9, 3 * 3.6, 18, 12)
.Text = Format(i \ 16, "!@@")
End With
Next
For i = 16 To y - 1 Step 16
With ActiveSheet.TextBoxes.Add(3 * 3.6, 3 * i - 9, 12, 18)
.Orientation = xlDownward
.Text = Format(i \ 16, "!@@")
End With
Next
With ActiveSheet.TextBoxes
.Font.Size = 9
.Font.ColorIndex = 55
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Border.ColorIndex = xlNone
.Interior.ColorIndex = xlNone
End With

With ActiveSheet.DrawingObjects.Group
.Placement = xlFreeFloating
.Width = Application.InchesToPoints(x / 16)
.Height = Application.InchesToPoints(y / 16)
.CopyPicture xlScreen, xlPicture
ActiveSheet.Paste
x2 = (Selection.Width - .Width) / 3
y2 = (Selection.Height - .Height) / 3
Selection.Delete
.CopyPicture xlPrinter, xlPicture
ActiveSheet.Paste
.Width = .Width * .Width / (Selection.Width - x2 * 2) *
Screen_Width / Printer_Width
.Height = .Height * .Height / (Selection.Height - y2 * 2) *
Screen_Height / Printer_Height
Selection.Delete
If Val(Application.Version) = 9 Then
.Copy
ActiveSheet.PasteSpecial 'Format:="Picture (PNG)"
With Selection.ShapeRange.PictureFormat
.CropLeft = x2
.CropTop = y2
.CropRight = x2
.CropBottom = y2
End With
Selection.Copy
ws.Activate
ws.PasteSpecial 'Format:="Picture (PNG)"
Selection.Placement = xlFreeFloating
.Parent.Parent.Close False
End If
End With
Application.ScreenUpdating = True
End Sub