Add excel horizontal & vertical ruler

[snbahri]

Why not have a horizontal & vertical ruler on a work sheet, I have been
trying to obtain an exact size of 17 cm height * 12 cm width.it is quite
impossible.
Adding the rulers as an option for the user makes it easier to perform the
sizing needed.

----------------
This post is a suggestion for Microsoft, and Microsoft responds to the
suggestions with the most votes. To vote for this suggestion, click the "I
Agree" button in the message pane. If you do not see the button, follow this
link to open the suggestion in the Microsoft Web-based Newsreader and then
click "I Agree" in the message pane.

http://www.microsoft.com/office/comm...heet.functions

[damorrison]

i agree

[dominicb]

Good morning snbahri

This is not really impossible with Excel.

Will different users with different screen resolutions see different sized cms? In Word the screen layout you see is 1 sheet of paper (say, A4) and that is what the measurement refers to. In excel the printable area is whatever you make it - you can print the whole thing, just a portion of it, miss bits out, zoom in (via the print settings etc). Therefore any ruler on the screen would be completely irrelevant once the user decides (what) to print.

HTH

DominicB

[damorrison]

good point

[snbahri]

Dominicb,
Thanks for your reply, although I am in no way an expert but willing to learn.
I am working on a certain approach that requires a defined sizing of 17cm in height x 12 cm in width, my text should be confined to these measurements.
Well, I did come prety close by adjusting cell hight & width, but upon printing in B&W, I get the exact size, when I go to color; the size shrinks by 2-3 cm.
I tried printing pdf & that did not work either.
If you have a solution or any one in the forum, would very much appreciate any help.
Thanks
snbahri

[damorrison]

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

[snbahri]

Thank you for the details, although it is quite complicated for me, it did
work, but I found a rather very primitive way( thanks to Microsoft) to bind
my text in a cadre exactly the dimensions I require, all I did was draw a
line, double click it & insert the width in cm. same to the height, now I
have to confine my self within it.
:-) :-)
Thanks again
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
>
>

[snbahri]

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