Image is broken after copying to new workbook? - vba

When I use vba to copy a worksheet to another workbook, one of my image picture will be broken with this error:
Dim filename as string
filename = "copyToThisExcel.xlsm"
Workbooks.Open filename:= "C:\myExcelFile.xlsm"
Sheets("Sheet1").Select
Sheets("Sheet1").Copy After:=Workbooks(filename).Sheets(1)
This happens randomly on computers and not others. I believe it is a known bug for 2007 and 2010 excel. Is there any workaround this or different alternatives to add images to excel that would not cause this issue?
Here is a link to this known bug.
http://www.spreadsheet1.com/excel-vba-bugs.html

I think you have to open the destinaion file. Look at this example :
Option Explicit
Sub test()
Dim filename As String
filename = "myFile2.xlsm"
Workbooks.Open filename:="C:\temp\myFile2.xlsm"
Workbooks.Open filename:="C:\temp\myFile1.xlsm"
Sheets("Sheet1").Copy After:=Workbooks(filename).Sheets(1)
End Sub

Related

Read content when an Excel workbook is closed using Excel VBA

I've two excel vba workbooks: 'Formini1.xlsm' as the source file; 'Tampil1.xlsm' as the target file.
The main fuction is: I've an advanced filter search in the target file. When I write a keyword and click the button this workbook, it searches in the source file and displays the related data in the target file.
Here's the code:
Private Sub CommandButton1_Click()
Dim RangeKriteria As Range, RangeCopyTo As Range, RangeTabel As Range
Set RangeTabel = Workbooks("formini1.xlsm").Sheets("Sheet3").[A1].CurrentRegion
Set RangeCopyTo = Workbooks("tampil1.xlsm").Sheets("Sheet2").[L1]
Set RangeKriteria = Workbooks("tampil1.xlsm").Sheets("Sheet2").[A1:I10]
With Workbooks("tampil1.xlsm").Sheets("Sheet2")
.Cells.Clear
.[A1:I1].Value = Workbooks("formini1.xlsm").Sheets("Sheet3").[A1:I1].Value
.[A2].Value = "*" & TextBox1.Value
.[B3].Value = "*" & TextBox1.Value
RangeTabel.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=RangeKriteria _
, CopyToRange:=RangeCopyTo, _
Unique:=False
End With
End Sub
The problem is, in real implementation the source file ("formini1.xlsm")doesn't/mustn't always be opened. Is there any idea to fix the problem?
You need to open the source file if it's closed. Add the following:
Sub Macro3()
Dim book As Workbook
Dim filepath As String
filepath = "C:\your_path\formini1.xlsm"
'Open the workbook as read only to avoid access conflicts
Set book = Workbooks.Open(Filename:=filepath, ReadOnly:=True)
' Close the workbook after you have read the data
book.Close
End Sub
I tested having the file already open, and for me, it did not fail. If it does fail if already open, trap for the error and continue.

VBA Save as runtime error 1004

I have written this VBA code to save a new version of a file in a specified location. It works absolutely fine on my computer but won't work on a colleagues. We are both using the same version of Excel. I have made sure there are no passwords in the workbook and also made sure he has full permissions on the file.
Sub SaveNew()
Dim FileName As String
Dim Path As String
Dim Plnt As String
Dim PC As String
Dim fso As FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
'Save and calculate workbook before changes. Patse Filename so it doesnt change
ActiveWorkbook.Save
ActiveSheet.Calculate
ActiveSheet.Select
Range("c7").Copy
Range("c8").PasteSpecial xlPasteValues
'Define path and filename
Path = "Z:\UK\BFD\MAReports$\PPV & MR21\Stock Loss\Site Files\"
FileName = Sheets("Menu").Range("c8")
Plnt = Sheets("Menu").Range("c3")
PC = Sheets("Menu").Range("c5")
'Save new version
ThisWorkbook.SaveAs FileName:=Path & FileName & ".xlsm", FileFormat:=52
Any help appreciated!
There's a couple of things that are odd about this code, see comments to the right:
ActiveWorkbook.Save 'saves the current book (that's ok)
ActiveSheet.Calculate 'only meaningful if you have calculation set to manual
ActiveSheet.Select 'why select the activesheet, you're not using the selection
Range("c7").Copy 'why copy/paste c7 to c8? if c7 is empty the saveAs fails
Range("c8").PasteSpecial xlPasteValues 'this is better: Range("c8").Value = Range("c7").Value
And probably the problem you have is either caused by:
1- SaveAs does not save a copy but saves the current workbook under a new name so if another user on another computer runs the same macro and Z: is a shared drive then the other user/computer will have the same file locked that you want to save to until on the other computer Excel is closed and the other user/computer and you/your computer have the same privileges on this file.
2- You/your computer has no authorization to write on that network location
I've tested your code and I can replicate cause 1 with the same 1004 runtime error

Excel after saving 10 files give me error

I have created one script which is launched on click button, so it loads CSV file from path and format and than save it. As I have files from 1...10000 so I made file like 1.txt and so on.
I am getting problem is when it start process everything goes fine but after 10-13 files it give error and excel closes. Following are codes I am using. Please assist me where I am doing mistake. I think I am doing mistake in array I tried redim but but that one gives me same error. This is sub which I placed on my button to start process. As I have more than thousands files so please suggest me solution.
Sub WorkbooksLoop()
' get the list of filenames
Dim pageStart As Integer
Dim pageEnd As Integer
pageStart = CInt(Cells(3, "C").Value) ' getting from cell of excel sheet
pageEnd = CInt(Cells(4, "C").Value) ' getting from cell of excel sheet
Dim Filenames(44) As String ' variable I know there are 44 files
For j = pageStart To pageEnd
Filenames(j) = CStr(j) + ".txt"
Next j
On Error GoTo NoFilenames
Dim controllerwb As Workbook
Set controllerwb = ActiveWorkbook
Dim wb As Workbook
Dim fname As Variant
Dim rootPath As String
rootPath = ThisWorkbook.Path
rootPath = rootPath & "\"
For Each fname In Filenames
' Make the controller active
controllerwb.Activate
On Error Resume Next
' If activate fails, then the workbook isn't open
Workbooks(fname).Activate
' If activate fails, then the workbook isn't open
If Err <> 0 Then
OpenFile (rootPath & fname)
Set wb = ActiveWorkbook
wb.Activate
' Otherwise, workbook is already open, refer to it by name
Else
OpenFile (rootPath & fname)
Set wb = ActiveWorkbook
End If
' do something to the open workbook my process to format sheet
deletingRowsColumns
ledgerSetup
resizeColumns
columnLines
columnAlignments
mergeTitles
settingNames
wb.Close
Next fname
NoFilenames:
End Sub
I have done everything and recode it in different way. But still after 10-20 files it through an error. As I was using windows machine on my mac as virtual machine, so I just thought why not i try it on mac with microsoft office. And have to change just forward slashes of directory to colon(interesting I thought it should be back slash but that is how vba was doing) and it worked I get alert of some file not saving, but it is ok at least I could do 1000 files easily rest I can save manually. But it realy work although vba engine is little bit slower in mac but who cares I just leave it for few hours to do all files for me.
Thanks for all your help. Mike yes I need to learn more about ActiveWorkbook and scripting. I will try to do as you told me but my work done. Thanks

Copy every worksheet from one excel file to another

Having this, probably easy to solve problem, but without any programing skills its hard for me to crack...
I made an excel file with a button, a macro assigned to it.
What it should do :
Open another xls file, for which the user can search on harddrive
copy every sheet from the opened file
Paste it to the original file and close the one it was copied from.
So far I got this:
Sub Importfile()
Dim sFile As String
Dim wb As Workbook
sFile = Application.GetOpenFilename("*.xls,*.xls")
If sFile <> "False" Then
Set wb = Workbooks.Open(sFile)
'Copy and paste code , where I dont know what to do
wb.Close
End If
End Sub
Your example code is right, looking at the recorded macro code should have shown you how to use the worksheet.copy method. Using that you would just have to loop through all the worksheets in your newly opened workbook and copy them to your original workbook.
I've used a For Each, you could also just a plain For or any other sort of loop that you like.
Sub Importfile()
Dim sFile As String
Dim wb As Workbook
Dim ws As Worksheet
sFile = Application.GetOpenFilename("*.xls,*.xls")
If sFile <> "False" Then
Set wb = Workbooks.Open(sFile)
For Each ws In wb.Worksheets
ws.Copy before:=ThisWorkbook.Worksheets(1)
Next ws
wb.Close
End If
End Sub
The macro works fine for me! Please make sure that you have placed the code in the correct location.
In the image below "Book1" is your original sheet (the one you are copying sheets to) the macro code should be inserted into a "module" (the red square) and not any of the ones in the orange square. If you do not have a "module 1" (or any other) you need to insert a new one by looking in the "insert" menu at the top of the vba editor.

VBA - How to copy row in Excel from one workbook to another?

Despite many posts I have looked through being of along the same lines as my question, none of the answers satisfy what I am looking for. If you can link me to one I'd gladly read it.
I have a workbook with worksheets. For simplicity, let's say my workbook has a worksheet. And in my worksheet which is called "Sheet1", there is data in cells A1 to A4.
What I want my VBA code to do is:
Copy row 1 (or specifically cells A1 to A4) of Workbook 'A' into Range variable 'myRange'
Create a new workbook, let's call this one Workbook 'B'
Give Workbook 'B's default "sheet1" a new name to "Test Name"
Open Workbook 'B' (though I realise that VBA code "Workbooks.Add" opens a new book so this step may be redundant since Workbooks.Add covers half of point 2 and 3)
Paste 'myRange' into first row of 'Workbook B'
Save 'Workbook B' with name "Test Book" and a timestamp enclosed in square brackets. The file must also be of the file extension "xls"
Close 'Workbook B' and return to 'Workbook A'
What I have so far is this:
Sub OpenAndSaveNewBook()
'Declarations
Dim MyBook As String
Dim MyRange As Range
Dim newBook As Workbook
'Get name of current wb
MyBook = ThisWorkbook.Name
Set MyRange = MyBook.Sheets("Sheet1").Range("A1,F1")
'Create/Open new wb
newBook = Workbooks.Add
'Save new wb with XLS extension
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "/" & "TEST-BOOK", _
FileFormat:=xlNormal, CreateBackup:=False
'===NOTE: BEFORE THE FOLLOWING RUNS I NEED TO PERFORM ACTIONS ON CELLS VIA VBA ON
'===WORKBOOK 'A'. DOES THE NEWLY CREATE WORKBOOK BECOME THE PRIMARY/ACTIVE WORKBOOK
'===? AND SO THEN DO I NEED TO ACTIVATE WORKBOOK 'A'?
ActiveWorkbook.Close savechanges:=True
'Return focus to workbook 'a'
MyBook.Activate
End Sub
As you can see, I am lacking the code that will handle:
the pasting of my copied data to the new workbook
the changing of the new workbook's sheet1 name to something else
adding a timestamp to the filename string on save
Lastly, I have included a question in my code as I think I may have a misunderstanding of the ActiveWorkbook method. AFAIK when the code "Workbooks.Add" runs this becomes the Active Workbook, i.e. one with the focus. Does this effect how the VBA code running on Workbook 'A'? Does this mean that if I wanted to add code to manipulate cells of Workbook 'A' then I would need to use "MyBook.Activate" where 'MyBook' holds the string of Workbook 'A's actual title?
Any help will be greatly appreciated.
Thanks,
QF
Instead of copy pasting the way you mentioned above, you can directly do this. This will also negate the use of a variable.
MyBook.Sheets("Sheet1").Rows("1:4").copy _
newBook.Sheets("Sheet1").Rows("1")
EDIT
I just noticed an error with your code.
newBook = Workbooks.Add
This line will give you an error as you have to use Set
Your code can be written as
Option Explicit
Sub OpenAndSaveNewBook()
Dim MyBook As Workbook, newBook As Workbook
Dim FileNm As String
Set MyBook = ThisWorkbook
FileNm = ThisWorkbook.Path & "\" & "TEST-BOOK.xls"
Set newBook = Workbooks.Add
With newBook
MyBook.Sheets("Sheet1").Rows("1:4").Copy .Sheets("Sheet1").Rows("1")
'Save new wb with XLS extension
.SaveAs Filename:=FileNm, FileFormat:=xlNormal, CreateBackup:=False
.Close Savechanges:=False
End With
End Sub
MORE EDIT
Elaborating on the use of SET
I would recommend you to see this post.
LINK: Worksheets does not work
Avoid references to ActiveWorkbook in favour of explicit references wherever possible.
As you've found, it can be confusing knowing what's currently active, and you do not need to activate a workbook to manipulate it.
So you should be using
newBook.SaveAs...
newBook.Close...
Recorded macros tend to activate workbooks in order to work on them, but that's because that's the way a human who recorded them works! All activation really does is change focus.
The same applies to making selections and then manipulating the current selection; it's not necessary in VBA and tends to be slower than direct manipulation.
The awesome thing about Excel is the 'Record Macro' function. I started recording a macro and just followed the steps you outlined, then made a few minor modifications to the code that Excel provided as the recorded macro:
Range("A1:F1").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Sheets("Sheet1").Name = "Test Name"
Application.CutCopyMode = False
myNewFileName = myPath & myTestName & "_" & Date & ".xls"
ActiveWorkbook.SaveAs Filename:=myNewFileName _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
The Date function returns the current system date. It is important to note that the square brackets that you wanted are not valid filename characters; Excel will throw an error if you try to use those.
Turn the macro-recorders on; carefully execute the steps you want; stop the recorder; "edit" the macro generated. Fix as you need to make the program you intend, e.g., to parameterize it.