Results 1 to 13 of 13
  1. #1
    4 Star Lounger
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    472
    Thanks
    43
    Thanked 0 Times in 0 Posts

    Need code to position graphic on label

    MSO 2010 Win 7

    Hi
    Firstly, I am wanting to create a label at specific position on an Avery label sheet (DL24NZ). I will then sset the margins for the cells, then I wish to insert a graphic at specific location and set it as background, so the text essentially prints onto of the graphic.

    Any help would be appreciated
    cheers

    Phil Carter

  2. Subscribe to our Windows Secrets Newsletter - It's Free!

    Get our unique weekly Newsletter with tips and techniques, how to's and critical updates on Windows 7, Windows 8, Windows XP, Firefox, Internet Explorer, Google, etc. Join our 480,000 subscribers!

    Excel 2013: The Missing Manual

    + Get this BONUS — free!

    Get the most of Excel! Learn about new features, basics of creating a new spreadsheet and using the infamous Ribbon in the first chapter of Excel 2013: The Missing Manual - Subscribe and download Chapter 1 for free!

  3. #2
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,820
    Thanks
    0
    Thanked 167 Times in 154 Posts
    Hi Phil,

    You could use something along the lines of:
    Code:
    Sub Demo()
    Application.ScreenUpdating = False
    Dim Rng As Range, i As Long, Shp As Shape, ImageName As String
    ImageName = "C:\Users\" & Environ("UserName") & "\Documents\Pictures\MyPicture.jpg"
    With ActiveDocument.Tables(1).Range
      For i = 1 To .Cells.Count
        Set Rng = .Cells(i).Range
        Rng.Collapse
        Set Shp = .InlineShapes.AddPicture(FileName:=ImageName, SaveWithDocument:=True, Range:=Rng).ConvertToShape
        With Shp
          .LockAspectRatio = True
          .Left = CentimetersToPoints(1.5)
          .Top = CentimetersToPoints(0.5)
          .Width = CentimetersToPoints(2.5)
          .WrapFormat.Type = wdWrapBehind
        End With
        DoEvents
      Next
    End With
    Set Rng = Nothing
    Application.ScreenUpdating = True
    End Sub
    Last edited by macropod; 2012-07-04 at 21:42. Reason: Revised code to work with cells already containing other content
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  4. #3
    4 Star Lounger
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    472
    Thanks
    43
    Thanked 0 Times in 0 Posts
    Paul thanks for that

    That inserts the graphic in all cells. What I want is to be able to select a particular position, using "Dialogs(wdDialogToolsEnvelopesAndLabels)", on the sheet to place the graphic and then add a Persons name and company at a leftindent of 1.67 cm (max to 3 lines).
    cheers

    Phil Carter

  5. #4
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,820
    Thanks
    0
    Thanked 167 Times in 154 Posts
    Hi Phil,

    It would have been helpful had you specified the use of the dialog for choosing a particular label on the sheet.

    Since you can't use that dialogue to position the graphic or to set the text position, because the output goes direct to the printer without the creation of a document, some circumlocution is involved:
    Code:
    Sub Test()
    Application.ScreenUpdating = False
    Dim Rng As Range, lRow As Long, lCol As Long, Shp As Shape, ImageName As String, StrTxt As String, Doc As Document
    ImageName = "C:\Users\" & Environ("UserName") & "\Documents\Pictures\MyPicture.jpg"
    lRow = 3: lCol = 2
    With Dialogs(wdDialogToolsEnvelopesAndLabels)
      .SingleLabel = 1
      .LabelRow = lRow
      .LabelColumn = lCol
      .Display
      If .PrintEnvLabel = -1 Then
        lRow = .LabelRow
        lCol = .LabelColumn
        StrTxt = .AddrText
        Set Doc = Application.MailingLabel.CreateNewDocumentByID(LabelID:="805958201", Address:="", AutoText:="", _
          LaserTray:=wdPrinterManualFeed, ExtractAddress:=False, PrintEPostageLabel:=False, Vertical:=False)
        With Doc
          Set Rng = .Tables(1).Cell(lRow, lCol).Range
          Rng.Text = StrTxt
          Rng.ParagraphFormat.LeftIndent = CentimetersToPoints(1.67)
          Rng.Collapse
          Set Shp = .InlineShapes.AddPicture(FileName:=ImageName, SaveWithDocument:=True, Range:=Rng).ConvertToShape
          With Shp
            .WrapFormat.Type = wdWrapBehind
            .LockAspectRatio = True
            .Left = CentimetersToPoints(1.5)
            .Top = CentimetersToPoints(0.5)
            .Width = CentimetersToPoints(2.5)
          End With
          .PrintOut
          .Close SaveChanges:=False
        End With
        Set Rng = Nothing: Set Doc = Nothing
      End If
    End With
    Application.ScreenUpdating = True
    End Sub
    As coded, the dialogue will default to label 2 on row 3 (via lRow = 3: lCol = 2), you can delete that line or change the defaults to something else. Via the Rng object, you can apply whatever formatting you want to the output text.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  6. #5
    4 Star Lounger
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    472
    Thanks
    43
    Thanked 0 Times in 0 Posts
    Paul hi
    Sorry I didn't specify that.

    Seems to mostly work as required although there are a couple of issues.

    Firstly, the graphic doesn't seem to be in the background but the code does appear to set that, can't figure that one!

    Secondly, is it possible to create up to 10 different labels prior to printing?
    cheers

    Phil Carter

  7. #6
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,820
    Thanks
    0
    Thanked 167 Times in 154 Posts
    Hi Phil,

    I'm unable to reproduce the issue you say you're having with the graphic. If you can post a copy of the one you're using I can test whether there's anything special about it.

    As for the "is it possible to create up to 10 different labels prior to printing?", if you mean 10 printouts of the same label, sure, but if you mean labels in 10 locations on the same sheet, I can't see how you're going to get anything for that from the dialogue box. Of course, if you were to pre-print your labels with the graphic, none of the code in my second post would be needed (you might want to keep the first macro for adding the graphic to all labels).
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  8. #7
    4 Star Lounger
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    472
    Thanks
    43
    Thanked 0 Times in 0 Posts
    Paul hi

    I have identified the issue and it appears that only the first line of the text entered in the address box in the dialogue is printing on the label

    I am assuming it has somethng to do with the code "Rng.Text = StrTxt" because you identify it from "StrTxt = .AddrText" whhich I assume is the text entered in the address box on the dialogue.

    The other issue was just on the off chance it was easy enough but the users will just have print them one by one
    cheers

    Phil Carter

  9. #8
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,820
    Thanks
    0
    Thanked 167 Times in 154 Posts
    Hi Phil,

    It appears there is no way to capture more than the first line of the address from the label box. You can return all of that dialogue's variable contents via:
    Code:
    Sub Demo()
    Application.ScreenUpdating = False
    Dim StrTxt As String
    With Dialogs(wdDialogToolsEnvelopesAndLabels)
      .Display
      If .PrintEnvLabel = -1 Then
        StrTxt = .ExtractAddress & vbTab & .LabelListIndex & vbTab & .LabelIndex & vbTab & .LabelDotMatrix & vbCr & _
          .LabelTray & vbTab & .LabelAcross & vbTab & .LabelDown & vbTab & .EnvAddress & vbCr & _
          .EnvOmitReturn & vbTab & .EnvReturn & vbTab & .PrintBarCode & vbTab & .SingleLabel & vbCr & _
          .LabelRow & vbTab & .LabelColumn & vbTab & .PrintEnvLabel & vbTab & .AddToDocument & vbCr & _
          .EnvWidth & vbTab & .EnvHeight & vbTab & .EnvPaperSize & vbTab & .PrintFIMA & vbCr & _
          .UseEnvFeeder & vbTab & .Tab & vbTab & .AddrAutoText & vbTab & .AddrText & vbCr & _
          .AddrFromLeft & vbTab & .AddrFromTop & vbTab & .RetAddrFromLeft & vbTab & .RetAddrFromTop & vbCr & _
          .LabelTopMargin & vbTab & .LabelSideMargin & vbTab & .LabelVertPitch & vbTab & .LabelHorPitch & vbCr & _
          .LabelHeight & vbTab & .LabelWidth & vbTab & .CustomName & vbTab & .RetAddrText & vbCr & _
          .EnvPaperName & vbTab & .DefaultFaceUp & vbTab & .DefaultOrientation & vbTab & .RetAddrAutoText & vbCr & _
          .VerticalEnvelope & vbTab & .VerticalLabel & vbTab & .RecipientNamefromLeft & vbTab & .RecipientNamefromTop & vbCr & _
          .RecipientPostalfromLeft & vbTab & .RecipientPostalfromTop & vbTab & .SenderNamefromLeft & vbTab & .SenderNamefromTop & vbCr & _
          .SenderPostalfromLeft & vbTab & .SenderPostalfromTop & vbTab & .PrintEPostage & vbTab & .PrintEPostageLabel
        MsgBox StrTxt
        Exit Sub
      End If
    End With
    Application.ScreenUpdating = True
    End Sub
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  10. #9
    4 Star Lounger
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    472
    Thanks
    43
    Thanked 0 Times in 0 Posts
    Paul hi

    Not really ideal as it retruns 4 columns of numbers with the frist line (my name) mixed into it when I entered:
    Phil Carter
    Technical Expert
    IANZ

    LabelAddress.JPG
    cheers

    Phil Carter

  11. #10
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,820
    Thanks
    0
    Thanked 167 Times in 154 Posts
    Phil,

    That code isn't for production use - it's just to show what each of the dialogue's parameters returns. As you can see, if you put two or more lines of text into the address box, none of the variables returns the extra lines. Only the first line can be retrieved, via .AddrText. If you need more than one line, that's a show-stopper. It affects all Word versions back to 2003, at least, and one of my MVP colleagues has now logged it as a bug with MS. Until/unless MS releases a fix, short of writing your own version of that entire dialogue, nothing more can be done.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  12. #11
    4 Star Lounger
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    472
    Thanks
    43
    Thanked 0 Times in 0 Posts
    Mmmmm

    Thanks for your help Paul
    cheers

    Phil Carter

  13. #12
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,820
    Thanks
    0
    Thanked 167 Times in 154 Posts
    Hi Phil,

    The feedback I've had from MS is that the bug won't be fixed at this time - possibly not even when the next version of Word is released.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  14. #13
    4 Star Lounger
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    472
    Thanks
    43
    Thanked 0 Times in 0 Posts
    Paul hi
    I have been doing quite a bit of testing on this problem and have found a worked around for the multiple lines.
    I have set a LH Tab stop for each label 6.5cm, 13.5cm & 20.5cm, (sheet is 8x3) to give a RH margin of 0.4cm
    When the mailing label dialogue opens I enter the persons Name on first line, Ctrl Tab, and text for second line.

    Works a treat!

    Thanks very much, once again, for your time and help with this
    cheers

    Phil Carter

Posting Permissions

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