Results 1 to 7 of 7
  1. #1
    Gold Lounger
    Join Date
    Feb 2004
    Location
    Cape Town, RSA
    Posts
    3,444
    Thanks
    0
    Thanked 1 Time in 1 Post

    Help with VBA code to insert a WB Stamp (Excel 2003)

    Hi,

    Please open the attached file. It contains a little WB that has a macro to insert a Confidential Stamp. The stamp works great, but I am having trouble trying to determine the number of columns the stamp text runs through in order to shade the background to yellow. In the VBA code I have inserted my questions as comments. Please review them and help me out as I have taken it as far as I can.

    TX a stack!
    Attached Files Attached Files
    Regards,
    Rudi

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Help with VBA code to insert a WB Stamp (Excel 2003)

    Excel displays column width in characters, with the number of pixels after it in parentheses.

    A column has two width properties:
    Width gives the width in points (which is not the same as pixels). This is a read-only property.
    ColumnWidth gives the width in characters, same as in the interface. It can be read and set.
    You're storing Width in a variable, then using it to set ColumnWidth. Of course mixing up Width and ColumnWidth doesn't work correctly.

    You can round up a number x by using -Int(-x).

    I wouldn't merge cells, it causes all kinds of problems. Center across selection works better.

    Try this version:

    Sub ConfidentialStamp()
    Dim CustomMsg As String
    Dim OrigWidth As Single
    Dim CalcWidth As Single
    Dim NumColumns As Single

    'INSERT STAMP TEXT AND FORMAT
    '============================
    CustomMsg = InputBox("Supply the confidentiality reason", _
    "Confidential Message", "Sensitive Data")
    Rows("1:2").Insert Shift:=xlDown
    Range("A1").FormulaR1C1 = "Confidential : " & CustomMsg
    With Range("A1").Font
    .Name = "Arial"
    .FontStyle = "Bold"
    .Size = 8
    .ColorIndex = 3
    End With

    'FORMAT MERGE FILL
    '============================
    OrigWidth = Columns("A:A").ColumnWidth
    Columns("A:A").AutoFit
    CalcWidth = Columns("A:A").ColumnWidth
    Columns("A:A").ColumnWidth = OrigWidth

    NumColumns = -Int(-CalcWidth / OrigWidth)
    With Range("A1").Resize(1, NumColumns)
    .HorizontalAlignment = xlCenterAcrossSelection
    With .Interior
    .ColorIndex = 6
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    End With
    End With
    End Sub

  3. #3
    Gold Lounger
    Join Date
    Feb 2004
    Location
    Cape Town, RSA
    Posts
    3,444
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Help with VBA code to insert a WB Stamp (Excel 2003)

    Hans,

    Thank you for all the tips: The tip on avoiding merge is good... I agree. Also the round up by using -Int(-x)...Very interesting!!!

    Your version works MUCH better than mine, but here is one Little problem. If the spreadsheet has an existing heading... Say: "The South African Training Institute", and it is sized to font size 20, then the macro adds the stamp, but the shading extends to the length of the heading... and not the length of the stamp itself. Is there any way to change this?

    TX for help so far.
    Regards,
    Rudi

  4. #4
    Gold Lounger
    Join Date
    Feb 2004
    Location
    Cape Town, RSA
    Posts
    3,444
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Help with VBA code to insert a WB Stamp (Excel 2003)

    Aaha...

    I spotted the problem.

    If I have a heading in the sheet, the autofit command takes into account the heading and divides the extended column width with the original column width. So that is why the stamp comes out to the length of the heading and not the stamp.

    Hmmm... how do I get around this? Is there any way to determine the length of the stamp text and calculate the amount of columns the stamp extends across?

    Any ideas? TX
    Regards,
    Rudi

  5. #5
    Gold Lounger
    Join Date
    Feb 2004
    Location
    Cape Town, RSA
    Posts
    3,444
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Help with VBA code to insert a WB Stamp (Excel 2003)

    I was playing around and came up with this...

    <pre>
    NumChars = Len(Range("A1").Value)
    NumColumns = -Int(-NumChars / 8.43)
    With Range("A1").Resize(1, NumColumns)
    .HorizontalAlignment = xlCenterAcrossSelection
    .Interior.Color = vbYellow
    End With
    </pre>

    I am sure it can be improved though!
    Regards,
    Rudi

  6. #6
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Help with VBA code to insert a WB Stamp (Excel 2003)

    The 8.43 may not be valid for all workbooks - it depends on the font set as default. It's better to use ActiveSheet.StandardWidth instead.

  7. #7
    Gold Lounger
    Join Date
    Feb 2004
    Location
    Cape Town, RSA
    Posts
    3,444
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Help with VBA code to insert a WB Stamp (Excel 2003)

    TX.

    I will change it!
    Regards,
    Rudi

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •