|
-
Aug 23rd, 2017, 08:59 AM
#3
Thread Starter
New Member
Re: Excel macro works on all but one computer/laptop
 Originally Posted by westconn1
i can only assume that the selection is not as expected for some reason, which i can not guess at
i always recommend to avoid selecting or activating anything and to as far as possible avoid working with the selection object or active anything
for any further assistance (not that you got any so far), i think you would need to post the vba code, or even attach a workbook (zip first) with some sample data and the macro
Thanks Westconn1 for your speedy reply. I use select and activate so I can see how my development is progressing as I am a step by step to getting things automated type of 'developer'. IT is not my main role. I use VB to automate regular tasks where possible and where time allows. Often once it's working I don't often get time to go back and clean it up. I also use it to show users what is happening as they run the macro during training (a sign of my insecurity or to assure users - probably a bit of both).
Apologies but the excel file doesn't appear to want to upload (even zipped it is 539kb). So here is the code (I have stated 'IT STOPS HERE ON ONE PERSONS COMPUTER. EVERYONE ELSE IT WORKS at the point where the error message occurs on the 'rouge' laptop).
Option Explicit
Sub CreateSendPO()
Dim wdApp As Object
Set wdApp = CreateObject("Word.Application")
Dim outApp As Object
Set outApp = CreateObject("Outlook.Application")
Dim exApp As Object
Set exApp = CreateObject("Excel.Application")
Dim myDir As String
myDir = ActiveWorkbook.Path
With exApp
Dim poTo As String
poTo = Workbooks("PR and Budget Opex 2018.xlsm").Sheets("Requisition").Range("E5") & " PO dated " & Format(Now(), "yyyy-mm-dd hh-mm-ss") & ".docx"
End With
With wdApp
.Documents.Add
.Selection.PageSetup.Orientation = 1
.Visible = True
.Activate
Workbooks("PR and Budget Opex 2018.xlsm").Sheets("Requisition").Range("PO_Header").CopyPicture Appearance:=xlScreen, Format:=xlPicture
.Selection.PasteAndFormat (13)
Dim dat As Variant
Dim rng As Range
Dim i As Long
Dim val As String
Dim PO_rng As String
Set rng = Workbooks("PR and Budget Opex 2018.xlsm").Sheets("Requisition").Range("PO_Lines")
dat = rng
val = 1
For i = LBound(dat, 1) To UBound(dat, 1)
If dat(i, 1) <> "" Then
PO_rng = "PO_Line" & val
Workbooks("PR and Budget Opex 2018.xlsm").Sheets("Requisition").Range(PO_rng).CopyPicture Appearance:=xlScreen, Format:=xlPicture
.Selection.PasteAndFormat (13)
.Selection.ParagraphFormat.Spacebefore = 0
val = val + 1
Else
val = val + 1
End If
Next
Workbooks("PR and Budget Opex 2018.xlsm").Sheets("Requisition").Range("PO_Totals").CopyPicture Appearance:=xlScreen, Format:=xlPicture
.Selection.PasteAndFormat (13)
.Selection.InsertBreak 'IT STOPS HERE ON ONE PERSONS COMPUTER. EVERYONE ELSE IT WORKS
If Workbooks("PR and Budget Opex 2018.xlsm").Sheets("Requisition").Range("B35") <> "" Then
Workbooks("PR and Budget Opex 2018.xlsm").Sheets("Requisition").Range("PO_Virements").CopyPicture Appearance:=xlScreen, Format:=xlPicture
.Selection.PasteAndFormat (13)
Else
GoTo skipvire
End If
Set rng = Workbooks("PR and Budget Opex 2018.xlsm").Sheets("Requisition").Range("PO_Vire_Lines")
dat = rng
val = 1
For i = LBound(dat, 1) To UBound(dat, 1)
If dat(i, 1) <> "" Then
PO_rng = "PO_Virements" & val
Workbooks("PR and Budget Opex 2018.xlsm").Sheets("Requisition").Range(PO_rng).CopyPicture Appearance:=xlScreen, Format:=xlPicture
.Selection.PasteAndFormat (13)
val = val + 1
End If
Next
.Selection.InsertBreak
skipvire:
If Workbooks("PR and Budget Opex 2018.xlsm").Sheets("Requisition").Range("New_Supplier_Req") = "Y" Then
Workbooks("PR and Budget Opex 2018.xlsm").Sheets("Requisition").Range("PO_New_Supplier").CopyPicture Appearance:=xlScreen, Format:=xlPicture
.Selection.PasteAndFormat (13)
Else
End If
Workbooks("PR and Budget Opex 2018.xlsm").Sheets("Requisition").Range("PO_Sign_Off").CopyPicture Appearance:=xlScreen, Format:=xlPicture
.Selection.PasteAndFormat (13)
End With
ChDir "C:\Purchase Orders\"
With wdApp
.ActiveDocument.SaveAs2 fileName:="C:\Purchase Orders\" & poTo
.ActiveDocument.SendMail
End With
ChDir myDir
End Sub
Thanks
Mike
Tags for this Thread
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|