For Each Shape In ActiveSheet.Shapes Shape.Select With Selection .Placement = xlFreeFloating .PrintObject = False End With Next
VB:Thanks everybody for reading this.billPrinter() 'Written By Douglas J Polancih Jr ' 'moves down one cell until it encounters a blank 'Opens up view bill on the intranet and enters the value of the current cell. 'Then prints the bill to the currently active printer 'On Error Resume Next Dim IE As SHDocVw.InternetExplorer Set IE = CreateObject("INTERNETEXPLORER.APPLICATION") Do While ActiveCell.Value "" 'Is cell blank? Err.Number = 0 IE.Navigate "www.somewebaddress" IE.Visible = True Do While IE.Busy Or IE.ReadyState READYSTATE_COMPLETE DoEvents Loop 'enters pro number and brings up bill IE.Document.forms(0).uclLookupPro_txtNumber.Value = ActiveCell.Value IE.Document.forms(0).uclLookupPro_btnSearch.Click Do While IE.Busy DoEvents Loop If Err.Number 0 Then a = MsgBox("Pro Number was not found. Please recheck and enter manually", vbCritical, "Bill Not Printed") Else 'Here is where I would like to print the page End If ActiveCell.Offset(1, 0).Select 'move down to the next cell Loop End SubIf you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
VB:I used Step Into to view the operation of the code one line at a time.PrintArea() Application.ScreenUpdating = False Worksheets("Sheet1").Activate For t = 1 To 13141 Step 36 Range("A1")(t).Activate ActiveSheet.PageSetup.PrintArea = ActiveCell.CurrentRegion.Address Next t Application.ScreenUpdating = True End SubIf you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
Sub PrintSelectedCells() ' prints selected cells, use from a toolbar button or a menu Dim aCount As Integer, cCount As Integer, rCount As Integer Dim i As Integer, j As Long, aRange As String Dim rHeight() As Single, cWidth() As Single Dim AWB As Workbook, NWB As Workbook If UCase(TypeName(ActiveSheet)) <> "WORKSHEET" Then Exit Sub ' useful only in worksheets aCount = Selection.Areas.Count If aCount = 0 Then Exit Sub ' no cells selected cCount = Selection.Areas(1).Cells.Count If aCount > 1 Then ' multiple areas selected Application.ScreenUpdating = False Application.StatusBar = "Printing " & aCount & " selected areas..." Set AWB = ActiveWorkbook rCount = ActiveSheet.Cells.SpecialCells(xlLastCell).Row cCount = ActiveSheet.Cells.SpecialCells(xlLastCell).Column ReDim rHeight(rCount) ReDim cWidth(cCount) For i = 1 To rCount ' find the row height of every row in the selection rHeight(i) = Rows(i).RowHeight Next i For i = 1 To cCount ' find the column width of every column in the selection cWidth(i) = Columns(i).ColumnWidth Next i Set NWB = Workbooks.Add ' create a new workbook For i = 1 To rCount ' set row heights Rows(i).RowHeight = rHeight(i) Next i For i = 1 To cCount ' set column widths Columns(i).ColumnWidth = cWidth(i) Next i For i = 1 To aCount AWB.Activate aRange = Selection.Areas(i).Address ' the range address Range(aRange).Copy ' copying the range NWB.Activate With Range(aRange) ' pastes values and formats .PasteSpecial Paste:=xlValues, Operation:=xlNone, _ SkipBlanks:=True, Transpose:=False .PasteSpecial Paste:=xlFormats, Operation:=xlNone, _ SkipBlanks:=True, Transpose:=False End With Application.CutCopyMode = False Next i NWB.Printout NWB.Close False ' close the temporary workbook without saving Application.StatusBar = True AWB.Activate Set AWB = Nothing Set NWB = Nothing Else If cCount < 90 Then ' less than 90 cells selected If MsgBox("Are you sure you want to print " & _ cCount & " selected cells ?", _ vbQuestion + vbYesNo, "Print celected cells") = vbNo Then Exit Sub End If Selection.PrintOut End If End Sub
VB:...but it isn't working. It selects all cells from C1 to U100 instead of C1 to U13.Range("C1").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Range(Selection, Selection.End(xlUp)).SelectIf you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
VB:as there may be gaps in the data between columns C and U.Range(Selection, Selection.End(xlToRight)).SelectIf you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
ActiveCell.Offset(1, 0).Select ActiveSheet.OLEObjects.Add(Filename:= _ "document1.doc", Link:=False, _ DisplayAsIcon:=False).Select Selection.ShapeRange.Fill.Visible = msoTrue Selection.ShapeRange.Line.Visible = msoFalseThis works perfectly. What I need to do next is insert a page break, then the next document, but I don't know how to reference the next cell/row below the first embedded document.