I'm currently looking to put together a simple excel workbook filled with several dozen template forms we use (one per worksheet). As part of this I am looking to have a "master" sheet at the front which can with the press of a macro copy information into all the other worksheets.
Doing this for the cells has been easy, but I have had limited success in copying across any logos. My intention is to put my company's logo at the top right of the form and any client logos at the top left, hit a button and the 2-3 logos will appear in the same place across all the other worksheets.
I've managed to reposition the logos individually by name with the following code:
For Each Shape In Worksheet.Shapes
If Shape.Name = "OurLogo" Then
Shape.Left = (Wb1.Sheets("Inputs").Shapes("Our Logo").Left - 1)
Shape.Top = (Wb1.Sheets("Inputs").Shapes("Our Logo").Top - 1)
End If
Next Shape
Where Our Logo is the original logo and OurLogo is the copied and named logo.
However this means I need the logos already copied into the correct cell in each workbook with the correct name. I've managed to copy the logo across all the worksheets, but not been able to rename them as I've been going, they are just assigned "Picture#" as a name. I tried including a rename in a similar "For Each" macro to copy it across all the sheets, but this only renamed one logo pasted into the active worksheet and didn't rename any in the remaining worksheets.
Any advice on how to copy and rename these pictures to multiple worksheets while also renaming them would be greatly appreciated. Alternatively I would accept copying first and a method of renaming after with a second macro.
Thanks in advance for your help.
I previously tried the How to copy a Shape to another worksheet (not as a picture)?, method but setting the destination cell simply dumped the logo in the top left corner, looking very untidy when I wanted it centred - hence the repositioning macro based on the position of the original logo. The method under that link also renamed the logo to "Picture#", creating the renaming requirement.
The 2nd result when Googling for "Excel VBA shape copy" point to a nifty question here at SE.
How to copy a Shape to another worksheet (not as a picture)?
Pretty sure that will solve your problem.
i have done this with 1 shape
Sub CopyAndRenameShape()
Dim sh As Shape
Dim wks As Worksheet
Set sh = Sheet1.Shapes("shtTest")
For Each wks In ThisWorkbook.Worksheets
If wks.Name <> ActiveSheet.Name Then
sh.Name = wks.Name & "_" & sh.Name
sh.Copy
wks.Paste
End If
Next wks
sh.Name = "shtTest"
End Sub
Related
I amended the below so the links would go into a sheet of my choosing, but I get errors, I am keen to know is there a way of setting the ws of my choosing. I looked on the net and could not find a solution.
Sub ListLinks()
Dim wb As Workbook
Set wb = Application.ActiveWorkbook
If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
wb.Sheets.Add ' Amended this with my chosen sheet I want the links to go and I get errors after, declaring my variables, i.e ws as worksheet and the range
xIndex = 1
For Each link In wb.LinkSources(xlExcelLinks)
Application.ActiveSheet.Cells(xIndex, 1).Value = link
xIndex = xIndex + 1
Next link
End If
End Sub
I have a workbook, that has several worksheets that have two external links to two different workbooks.
I am unable to use left or right function to extract the path filename from a VLOOKUP FORMULA of a cell to a cell of my choosing, let's take the example of one link, let's say that I wanted to print the formula as text into cell B1 and then say C1 would have the path of the most updated file that I would want to change it to. Using VBA to change the file. Once this has updated the link, both B1 and C1 should = the same file and path location.
If I could do this than I would try to see if I could apply it to the second link.
Is there a way of printing the formula of a cell as text and then using left, middle or right to extract path and file location.
I thought about the above vba code but it adds a new sheet, I am unable to put the links into the sheet of my choosing. I get an error. I would be keen to use as less code as possible. I am a newbie in VBA, thoughts, and help would be appreciated.
If you wish to write to an existing sheet then instead of adding a sheet, you just need to specify the sheet on the writing line. So first remove the line wb.Sheets.Add. Then modify the write line - change ActiveSheet to Sheets("your sheet name"). In this example I've specified an existing sheet named "sandwich":
Sub ListLinks()
Dim wb As Workbook
Set wb = Application.ActiveWorkbook
If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
xIndex = 1
For Each link In wb.LinkSources(xlExcelLinks)
Application.Sheets("sandwich").Cells(xIndex, 1).Value = link
xIndex = xIndex + 1
Next link
End If
End Sub
Additional:
If you wish to get the path from the formula/link, without VBA you may be able to use a formula like this if you are using Excel 2013 or later (in this example, your link is in cell A1):
=SUBSTITUTE(SUBSTITUTE(MID(FORMULATEXT(A1),FIND("'",FORMULATEXT(A1),1)+1,(FIND("]",FORMULATEXT(A1),1)-FIND("'",FORMULATEXT(A1),1)-1)),"''","'"),"[","")
What I want to do
I want a code in my workbook (wbDestination) that opens another workbook (wbBosOriginal) and copies an entire sheet as values (wbBosOriginal has a lot of code in it, in modules and in the worksheet in question, and I do not want this code because it references stuff in wbB that doesn't exist in wbDestination). I have had great problems pasting as values, because it will not paste columns and rows that are currently hidden. So this is why I decided to import the whole sheet instead.
What I tried and what's wrong with it
Here is a block of code I used to copy the worksheet in the destination workbook, in the last index position. The problem with it is that some links still exist to the old workbook (Formulas, validation lists, conditionnal formatting). I have deleted all these links but STILL when I paste the sheet successfully, save and reopen, I have an error saying some content is unreadable. I believe there are still some elements linked to the old workbook.
Set wbBosOriginal = Workbooks.Open(strChosenPath, ReadOnly:=True)
With wbBosOriginal.Sheets("BOS")
.Visible = True
'Pastes the ws in last position in wbDestination
.Copy after:=wbDestination.Sheets(wbDestination.Worksheets.Count)
Set wsNewBos = Worksheets(Worksheets.Count)
'Deletes VBA code in the copied sheet
ThisWorkbook.VBProject.VBComponents.Item(wsNewBos.CodeName).CodeModule.DeleteLines 1, _
ThisWorkbook.VBProject.VBComponents.Item(wsNewBos.CodeName).CodeModule.CountOfLines
End With
The worksheet is successfully pasted with no code in it, with everything else it had previously. I then remove all formulas, conditionnal formatting, and validation lists. Even after removing those as well, I still get an error when opening the workbook.
My question
Apart from conditional formatting, validation lists, VBA code, and formulas linking a worksheet that was pasted to a new workbook, what other elements could cause the workbook from opening in repair mode every time due to existing links to the old workbook?
If my question is not clear, comment and I will clarify.
Dealing directly with VBE seems a bit heavy-handed to me. If your code is manipulating several workbooks, I would put the code in an add-in and not have it in any workbook. (Technically *.xlam addins are workbooks, but when I say "workbook" I mean normal *.xls, *.xlsx, *.xlsm, etc.)
That said, if you're just copying cell values (which may be formulas) between different workbooks, you shouldn't have any dependencies other than cell references, named ranges, and user-defined functions in the original workbook. I would make sure there are none of those. Please also share how you are ensuring your formulas do not have broken references.
If the issue you are having is caused by trying to avoid hidden columns and rows not allowing pastevalues, why not unhide the rows and columns and then copy only the values to the new book?
Just cycle through each of the sheets in the original book and use the method .UsedRange.Hidden = False. As far as I am aware, this should unhide every cell on the sheet and allow you to do the original pastevalues calls
This works fast and smooth (it's harder to delete ALL the data Imo):
Sub tests()
Dim AllRange As Range: Set AllRange = ActiveSheet.UsedRange
Dim ItemRange As Range
Dim myWbDestination As Workbook: Set myWbDestination = ThisWorkbook
Dim SheetDestination As String: SheetDestination = ("Sheet2")
For Each ItemRange In AllRange
With myWbDestination.Sheets(SheetDestination)
.Range(ItemRange.Address) = ItemRange.Value
End With
Next ItemRange
End Sub
Repair mode can be triggered by many factors, you would need to post the code you are getting to look for an explanation, it would be like asking why vba may broke
I have an Excel VBA macro that copies contents between files and sheets. One of the things that it does is copy content from a template into new sheets and then fills in the information on those sheets from other files. That's all working as expected. What's not acting as expected is the code to delete the buttons and shapes carried over from the template sheet into the information sheets. That code is within a for loop that acts on each page, yet it only is deleting these shapes from the last page while leaving them in place on every other page the loop touches. Everything else in the loop affects every page as expected.
The relevant section of my Macro is as follows. masterWB and currentWB are two separate workbooks:
For k = 1 To masterWB.Sheets.Count
j = k + 1
' Removed because irrelevant to this query:
' Copying of content from other workbooks to each sheet
' Copying of formatting to all lines with content within sheet
' All of this is still working as expected on every sheet.
' Deletes button copied from first (template) sheet
currentWB.Worksheets(j).Shapes.SelectAll
Selection.Delete
Next k
Trying to select shapes may require selecting the sheet first. Perhaps try adding the following currentWB.Activate and currentWB.Worksheets(j).Select before the line currentWB.Worksheets(j).Shapes.SelectAll
I'm not sure why you are looping through masterWB, but the shape delete operation relates to currentWB (as Jeeped states above), but try deleting the shapes directly rather than selecting them:
currentWB.Worksheets(j).Shapes.Delete
If that doesn't work, a separate loop perhaps:
Dim sht as worksheet
For each sht in currentWB.Worksheets
sht.shapes.delete
next sht
Something else worth noting - you are looping through sheets, but referring to worksheets by the same number. The Sheets collection contains worksheets, charts, macros, forms and other stuff - do you have any of these?
Hope this helps!
Good Morning All,
I'm just trying to understand how to run a macro that is in one workbook but apply the macro procedure/changes into another workbook that is open.
What I am trying to achieve is one workbook is say the Template that will always be open. I have a macro in that Template file that works through a directory looking for xlsm files and opens them one at a time. What I want to do is when the workbook is opened another macro is called in the Template file which updates connection string details in the other open workbook.
I have the macros ready and they work, but I want to run them against another workbook without having to copy the code into it.
Is this at all possible?
Thanks in advance.
Make a variable to store your workbook, then use it to refer to it. Something like this:
'place this at the top of the module so that the variable can be used by all macros
Private wb As Workbook
'place this in your "browse and open" macro in place right after you open a workbook
Set wb = ActiveWorkbook
'now you can do whatever you want by referring to wb
wb.Worksheets("Sheet 1").Range("A1") = "Cell A1"
wb.Worksheets("Sheet 2").Range("C3").EntireRow.Delete
wb.Close
You could also continue referring to ActiveWorkbook, but you have to make sure that it actually remains active all the time you want to work on it. If in the meantime you want to do something on your template workbook, you can refer to it as ThisWorkbook.
Sub h()
'ask for row number >>
k = InputBox("witch row?")
' you now define the worksheet >>
Sheet2.Select
'now you see that in this case i used a selected cell as point of reference>>
Sheet2.Range("a" & k).EntireRow.Delete
End Sub
In MS EXCEL Sheet1, go to "Insert tab", to "shapes",>>
select a rounded cornered box, add a text to it so its intuitive,>>
change the colors of text and background, then :>>
select the shape you created with the mouse with a "right click">>
and from the list that appears select "Assing Macro", and select macro "h"
if all goes to theese indications, we have the next step >>
if u click it it runns the sub. and therefor you will be presented with a inputbox, where you specify the row number you want to be deleted.
there you go!
p.s. hoping im clear.
I have a macro that creates a summary sheet at the front of a Workbook. Shapes are created and labeled after the sheets in the workbook and then hyperlinks are added to the shapes to redirect to those sheets, however, when I recorded the macro to do this, the code generated was:
ActiveSheet.Shapes.Range(Array("Rounded Rectangle 1")).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:=""
The hyperlinks that were manually created in excel while recording the macro work just fine and when hovering over them, display the file path and " - Sheet!A1" but they don't seem to actually be adding the link location into the address portion of the macro. Does anyone know the code that should go in that address section to link to the sheet?
The macro recorder doesn't record what is actually happening in this case. The property you are looking for is SubAddress. Address is correctly set in your code.
Create a hyperlink from a shape without selecting it
You want to avoid selecting things in your code if possible, and in this case it definitely is. Create a shape variable and set it to the shape you want to modify, then add the hyperlink to the sheet the shape is on. Note that you can also set the text for the screen tip.
In the example below, the shape I want to modify is on Sheet 6, and hyperlinks to a range on Sheet 4.
Sub SetHyperlinkOnShape()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet6")
Dim hyperLinkedShape As Shape
Set hyperLinkedShape = ws.Shapes("Rectangle 1")
ws.Hyperlinks.Add Anchor:=hyperLinkedShape, Address:="", _
SubAddress:="Sheet4!C4:C8", ScreenTip:="yadda yadda"
End Sub