Watermark macro
in [Word VBA]
|
Prev: ComboBox text Limit
Next: How to get every conytols
From: niros49 on 22 Apr 2010 13:38 I have recorded a macro to insert a picture watermark and then move the watermark to a new position on the page different then the default . The macro is crashing on line : Selection.ShapeRange.Name = "WordPictureWatermark1" Below is the recorded macro. Can anybody help? Thank you Sorin Sub Macropicture() ' ' Macropicture Macro ' Macro recorded 4/22/2010 by weisssx5 ' ActiveDocument.Sections(1).Range.Select ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader Selection.HeaderFooter.Shapes.AddPicture(FileName:= _ "C:\Documents and Settings\weisssx5\Desktop\Stamp Paint.bmp", LinkToFile _ :=False, SaveWithDocument:=True).Select Selection.ShapeRange.Name = "WordPictureWatermark1" Selection.ShapeRange.PictureFormat.Brightness = 0.5 Selection.ShapeRange.PictureFormat.Contrast = 0.5 Selection.ShapeRange.LockAspectRatio = True Selection.ShapeRange.Height = InchesToPoints(1.32) Selection.ShapeRange.Width = InchesToPoints(3.18) Selection.ShapeRange.WrapFormat.AllowOverlap = True Selection.ShapeRange.WrapFormat.Side = wdWrapNone Selection.ShapeRange.WrapFormat.Type = 3 Selection.ShapeRange.RelativeHorizontalPosition = _ wdRelativeVerticalPositionMargin Selection.ShapeRange.RelativeVerticalPosition = _ wdRelativeVerticalPositionMargin Selection.ShapeRange.Left = wdShapeCenter Selection.ShapeRange.Top = wdShapeCenter ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument If ActiveWindow.View.SplitSpecial <> wdPaneNone Then ActiveWindow.Panes(2).Close End If If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _ ActivePane.View.Type = wdOutlineView Then ActiveWindow.ActivePane.View.Type = wdPrintView End If ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader Selection.HeaderFooter.Shapes("WordPictureWatermark1").Select Selection.ShapeRange.IncrementLeft -164.65 Selection.ShapeRange.IncrementTop 65.6 ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument End Sub
From: Graham Mayor on 23 Apr 2010 01:31 The macro recorder has limitations and adds superfluous code. Using your approach, the following should work Sub Macropicture() ActiveDocument.Sections(1).Range.Select ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader Selection.HeaderFooter.Shapes.AddPicture(FileName:= _ "C:\Documents and Settings\weisssx5\Desktop\Stamp Paint.bmp", LinkToFile _ :=False, SaveWithDocument:=True).Select Selection.ShapeRange.name = "MyWMark" Selection.ShapeRange.PictureFormat.Brightness = 0.5 Selection.ShapeRange.PictureFormat.Contrast = 0.5 Selection.ShapeRange.LockAspectRatio = True Selection.ShapeRange.Height = InchesToPoints(1.32) Selection.ShapeRange.Width = InchesToPoints(3.18) Selection.ShapeRange.WrapFormat.AllowOverlap = True Selection.ShapeRange.WrapFormat.Side = wdWrapNone Selection.ShapeRange.WrapFormat.Type = 3 Selection.ShapeRange.RelativeHorizontalPosition = _ wdRelativeVerticalPositionMargin Selection.ShapeRange.RelativeVerticalPosition = _ wdRelativeVerticalPositionMargin Selection.ShapeRange.Left = wdShapeCenter Selection.ShapeRange.Top = wdShapeCenter Selection.ShapeRange.IncrementLeft -164.65 Selection.ShapeRange.IncrementTop 65.6 ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument End Sub It might be better to use Dim oHeader As HeaderFooter Set oHeader = ActiveDocument.Sections(1) _ ..Headers(wdHeaderFooterPrimary) With oHeader .Shapes.AddPicture FileName:= _ "C:\Documents and Settings\weisssx5\Desktop\Stamp Paint.bmp", _ LinkToFile:=False, SaveWithDocument:=True With .Shapes(1) .name = "MyWMark" .PictureFormat.Brightness = 0.5 .PictureFormat.Contrast = 0.5 .LockAspectRatio = True .Height = InchesToPoints(1.32) .Width = InchesToPoints(3.18) .WrapFormat.AllowOverlap = True .WrapFormat.Side = wdWrapNone .WrapFormat.Type = 3 .RelativeHorizontalPosition = _ wdRelativeVerticalPositionMargin .RelativeVerticalPosition = _ wdRelativeVerticalPositionMargin .Left = wdShapeCenter .Top = wdShapeCenter .IncrementLeft -164.65 .IncrementTop 65.6 End With End With -- <>>< ><<> ><<> <>>< ><<> <>>< <>><<> Graham Mayor - Word MVP My web site www.gmayor.com Word MVP web site http://word.mvps.org <>>< ><<> ><<> <>>< ><<> <>>< <>><<> "niros49" <niros49(a)discussions.microsoft.com> wrote in message news:CB003457-6EAD-4E7A-8938-42999BFBE09A(a)microsoft.com... >I have recorded a macro to insert a picture watermark and then move the > watermark to a new position on the page different then the default . The > macro is crashing on line : > > Selection.ShapeRange.Name = "WordPictureWatermark1" > > > Below is the recorded macro. > > Can anybody help? > > Thank you > > > Sorin > > Sub Macropicture() > ' > ' Macropicture Macro > ' Macro recorded 4/22/2010 by weisssx5 > ' > ActiveDocument.Sections(1).Range.Select > ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader > Selection.HeaderFooter.Shapes.AddPicture(FileName:= _ > "C:\Documents and Settings\weisssx5\Desktop\Stamp Paint.bmp", > LinkToFile _ > :=False, SaveWithDocument:=True).Select > Selection.ShapeRange.Name = "WordPictureWatermark1" > Selection.ShapeRange.PictureFormat.Brightness = 0.5 > Selection.ShapeRange.PictureFormat.Contrast = 0.5 > Selection.ShapeRange.LockAspectRatio = True > Selection.ShapeRange.Height = InchesToPoints(1.32) > Selection.ShapeRange.Width = InchesToPoints(3.18) > Selection.ShapeRange.WrapFormat.AllowOverlap = True > Selection.ShapeRange.WrapFormat.Side = wdWrapNone > Selection.ShapeRange.WrapFormat.Type = 3 > Selection.ShapeRange.RelativeHorizontalPosition = _ > wdRelativeVerticalPositionMargin > Selection.ShapeRange.RelativeVerticalPosition = _ > wdRelativeVerticalPositionMargin > Selection.ShapeRange.Left = wdShapeCenter > Selection.ShapeRange.Top = wdShapeCenter > ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument > If ActiveWindow.View.SplitSpecial <> wdPaneNone Then > ActiveWindow.Panes(2).Close > End If > If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _ > ActivePane.View.Type = wdOutlineView Then > ActiveWindow.ActivePane.View.Type = wdPrintView > End If > ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader > Selection.HeaderFooter.Shapes("WordPictureWatermark1").Select > Selection.ShapeRange.IncrementLeft -164.65 > Selection.ShapeRange.IncrementTop 65.6 > ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument > End Sub >
From: niros49 on 26 Apr 2010 15:05 I thank you very much for your help. Sorin "Graham Mayor" wrote: > The macro recorder has limitations and adds superfluous code. Using your > approach, the following should work > > Sub Macropicture() > ActiveDocument.Sections(1).Range.Select > ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader > Selection.HeaderFooter.Shapes.AddPicture(FileName:= _ > "C:\Documents and Settings\weisssx5\Desktop\Stamp Paint.bmp", > LinkToFile _ > :=False, SaveWithDocument:=True).Select > Selection.ShapeRange.name = "MyWMark" > Selection.ShapeRange.PictureFormat.Brightness = 0.5 > Selection.ShapeRange.PictureFormat.Contrast = 0.5 > Selection.ShapeRange.LockAspectRatio = True > Selection.ShapeRange.Height = InchesToPoints(1.32) > Selection.ShapeRange.Width = InchesToPoints(3.18) > Selection.ShapeRange.WrapFormat.AllowOverlap = True > Selection.ShapeRange.WrapFormat.Side = wdWrapNone > Selection.ShapeRange.WrapFormat.Type = 3 > Selection.ShapeRange.RelativeHorizontalPosition = _ > wdRelativeVerticalPositionMargin > Selection.ShapeRange.RelativeVerticalPosition = _ > wdRelativeVerticalPositionMargin > Selection.ShapeRange.Left = wdShapeCenter > Selection.ShapeRange.Top = wdShapeCenter > Selection.ShapeRange.IncrementLeft -164.65 > Selection.ShapeRange.IncrementTop 65.6 > ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument > End Sub > > It might be better to use > > Dim oHeader As HeaderFooter > Set oHeader = ActiveDocument.Sections(1) _ > ..Headers(wdHeaderFooterPrimary) > With oHeader > .Shapes.AddPicture FileName:= _ > "C:\Documents and Settings\weisssx5\Desktop\Stamp Paint.bmp", _ > LinkToFile:=False, SaveWithDocument:=True > With .Shapes(1) > .name = "MyWMark" > .PictureFormat.Brightness = 0.5 > .PictureFormat.Contrast = 0.5 > .LockAspectRatio = True > .Height = InchesToPoints(1.32) > .Width = InchesToPoints(3.18) > .WrapFormat.AllowOverlap = True > .WrapFormat.Side = wdWrapNone > .WrapFormat.Type = 3 > .RelativeHorizontalPosition = _ > wdRelativeVerticalPositionMargin > .RelativeVerticalPosition = _ > wdRelativeVerticalPositionMargin > .Left = wdShapeCenter > .Top = wdShapeCenter > .IncrementLeft -164.65 > .IncrementTop 65.6 > End With > End With > > > -- > <>>< ><<> ><<> <>>< ><<> <>>< <>><<> > Graham Mayor - Word MVP > > My web site www.gmayor.com > Word MVP web site http://word.mvps.org > <>>< ><<> ><<> <>>< ><<> <>>< <>><<> > > > "niros49" <niros49(a)discussions.microsoft.com> wrote in message > news:CB003457-6EAD-4E7A-8938-42999BFBE09A(a)microsoft.com... > >I have recorded a macro to insert a picture watermark and then move the > > watermark to a new position on the page different then the default . The > > macro is crashing on line : > > > > Selection.ShapeRange.Name = "WordPictureWatermark1" > > > > > > Below is the recorded macro. > > > > Can anybody help? > > > > Thank you > > > > > > Sorin > > > > Sub Macropicture() > > ' > > ' Macropicture Macro > > ' Macro recorded 4/22/2010 by weisssx5 > > ' > > ActiveDocument.Sections(1).Range.Select > > ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader > > Selection.HeaderFooter.Shapes.AddPicture(FileName:= _ > > "C:\Documents and Settings\weisssx5\Desktop\Stamp Paint.bmp", > > LinkToFile _ > > :=False, SaveWithDocument:=True).Select > > Selection.ShapeRange.Name = "WordPictureWatermark1" > > Selection.ShapeRange.PictureFormat.Brightness = 0.5 > > Selection.ShapeRange.PictureFormat.Contrast = 0.5 > > Selection.ShapeRange.LockAspectRatio = True > > Selection.ShapeRange.Height = InchesToPoints(1.32) > > Selection.ShapeRange.Width = InchesToPoints(3.18) > > Selection.ShapeRange.WrapFormat.AllowOverlap = True > > Selection.ShapeRange.WrapFormat.Side = wdWrapNone > > Selection.ShapeRange.WrapFormat.Type = 3 > > Selection.ShapeRange.RelativeHorizontalPosition = _ > > wdRelativeVerticalPositionMargin > > Selection.ShapeRange.RelativeVerticalPosition = _ > > wdRelativeVerticalPositionMargin > > Selection.ShapeRange.Left = wdShapeCenter > > Selection.ShapeRange.Top = wdShapeCenter > > ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument > > If ActiveWindow.View.SplitSpecial <> wdPaneNone Then > > ActiveWindow.Panes(2).Close > > End If > > If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _ > > ActivePane.View.Type = wdOutlineView Then > > ActiveWindow.ActivePane.View.Type = wdPrintView > > End If > > ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader > > Selection.HeaderFooter.Shapes("WordPictureWatermark1").Select > > Selection.ShapeRange.IncrementLeft -164.65 > > Selection.ShapeRange.IncrementTop 65.6 > > ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument > > End Sub > > > > > . >
From: Graham Mayor on 27 Apr 2010 02:10 You are welcome :) -- <>>< ><<> ><<> <>>< ><<> <>>< <>><<> Graham Mayor - Word MVP My web site www.gmayor.com Word MVP web site http://word.mvps.org <>>< ><<> ><<> <>>< ><<> <>>< <>><<> "niros49" <niros49(a)discussions.microsoft.com> wrote in message news:6A932DF8-F578-4249-B74C-6E82C50B3222(a)microsoft.com... >I thank you very much for your help. > > Sorin > > "Graham Mayor" wrote: > >> The macro recorder has limitations and adds superfluous code. Using your >> approach, the following should work >> >> Sub Macropicture() >> ActiveDocument.Sections(1).Range.Select >> ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader >> Selection.HeaderFooter.Shapes.AddPicture(FileName:= _ >> "C:\Documents and Settings\weisssx5\Desktop\Stamp Paint.bmp", >> LinkToFile _ >> :=False, SaveWithDocument:=True).Select >> Selection.ShapeRange.name = "MyWMark" >> Selection.ShapeRange.PictureFormat.Brightness = 0.5 >> Selection.ShapeRange.PictureFormat.Contrast = 0.5 >> Selection.ShapeRange.LockAspectRatio = True >> Selection.ShapeRange.Height = InchesToPoints(1.32) >> Selection.ShapeRange.Width = InchesToPoints(3.18) >> Selection.ShapeRange.WrapFormat.AllowOverlap = True >> Selection.ShapeRange.WrapFormat.Side = wdWrapNone >> Selection.ShapeRange.WrapFormat.Type = 3 >> Selection.ShapeRange.RelativeHorizontalPosition = _ >> wdRelativeVerticalPositionMargin >> Selection.ShapeRange.RelativeVerticalPosition = _ >> wdRelativeVerticalPositionMargin >> Selection.ShapeRange.Left = wdShapeCenter >> Selection.ShapeRange.Top = wdShapeCenter >> Selection.ShapeRange.IncrementLeft -164.65 >> Selection.ShapeRange.IncrementTop 65.6 >> ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument >> End Sub >> >> It might be better to use >> >> Dim oHeader As HeaderFooter >> Set oHeader = ActiveDocument.Sections(1) _ >> ..Headers(wdHeaderFooterPrimary) >> With oHeader >> .Shapes.AddPicture FileName:= _ >> "C:\Documents and Settings\weisssx5\Desktop\Stamp Paint.bmp", _ >> LinkToFile:=False, SaveWithDocument:=True >> With .Shapes(1) >> .name = "MyWMark" >> .PictureFormat.Brightness = 0.5 >> .PictureFormat.Contrast = 0.5 >> .LockAspectRatio = True >> .Height = InchesToPoints(1.32) >> .Width = InchesToPoints(3.18) >> .WrapFormat.AllowOverlap = True >> .WrapFormat.Side = wdWrapNone >> .WrapFormat.Type = 3 >> .RelativeHorizontalPosition = _ >> wdRelativeVerticalPositionMargin >> .RelativeVerticalPosition = _ >> wdRelativeVerticalPositionMargin >> .Left = wdShapeCenter >> .Top = wdShapeCenter >> .IncrementLeft -164.65 >> .IncrementTop 65.6 >> End With >> End With >> >> >> -- >> <>>< ><<> ><<> <>>< ><<> <>>< <>><<> >> Graham Mayor - Word MVP >> >> My web site www.gmayor.com >> Word MVP web site http://word.mvps.org >> <>>< ><<> ><<> <>>< ><<> <>>< <>><<> >> >> >> "niros49" <niros49(a)discussions.microsoft.com> wrote in message >> news:CB003457-6EAD-4E7A-8938-42999BFBE09A(a)microsoft.com... >> >I have recorded a macro to insert a picture watermark and then move the >> > watermark to a new position on the page different then the default . >> > The >> > macro is crashing on line : >> > >> > Selection.ShapeRange.Name = "WordPictureWatermark1" >> > >> > >> > Below is the recorded macro. >> > >> > Can anybody help? >> > >> > Thank you >> > >> > >> > Sorin >> > >> > Sub Macropicture() >> > ' >> > ' Macropicture Macro >> > ' Macro recorded 4/22/2010 by weisssx5 >> > ' >> > ActiveDocument.Sections(1).Range.Select >> > ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader >> > Selection.HeaderFooter.Shapes.AddPicture(FileName:= _ >> > "C:\Documents and Settings\weisssx5\Desktop\Stamp Paint.bmp", >> > LinkToFile _ >> > :=False, SaveWithDocument:=True).Select >> > Selection.ShapeRange.Name = "WordPictureWatermark1" >> > Selection.ShapeRange.PictureFormat.Brightness = 0.5 >> > Selection.ShapeRange.PictureFormat.Contrast = 0.5 >> > Selection.ShapeRange.LockAspectRatio = True >> > Selection.ShapeRange.Height = InchesToPoints(1.32) >> > Selection.ShapeRange.Width = InchesToPoints(3.18) >> > Selection.ShapeRange.WrapFormat.AllowOverlap = True >> > Selection.ShapeRange.WrapFormat.Side = wdWrapNone >> > Selection.ShapeRange.WrapFormat.Type = 3 >> > Selection.ShapeRange.RelativeHorizontalPosition = _ >> > wdRelativeVerticalPositionMargin >> > Selection.ShapeRange.RelativeVerticalPosition = _ >> > wdRelativeVerticalPositionMargin >> > Selection.ShapeRange.Left = wdShapeCenter >> > Selection.ShapeRange.Top = wdShapeCenter >> > ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument >> > If ActiveWindow.View.SplitSpecial <> wdPaneNone Then >> > ActiveWindow.Panes(2).Close >> > End If >> > If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. >> > _ >> > ActivePane.View.Type = wdOutlineView Then >> > ActiveWindow.ActivePane.View.Type = wdPrintView >> > End If >> > ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader >> > Selection.HeaderFooter.Shapes("WordPictureWatermark1").Select >> > Selection.ShapeRange.IncrementLeft -164.65 >> > Selection.ShapeRange.IncrementTop 65.6 >> > ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument >> > End Sub >> > >> >> >> . >>
|
Pages: 1 Prev: ComboBox text Limit Next: How to get every conytols |