I am working with a large macro, part of the code copies some cells to a chart object in order to save it as a .png and attach it to an email. After switching to windows 10, the chart object is empty. Oddly enough, if you add a breakpoint above the paste action, then resume the macro, everything works. This has me stumped. I've checked that the clipboard holds the table, and tried interrupting the code to replicate the breakpoint, nothing seems to work.
Edit:
this is the code that fails
Public Sub SaveTableRangeAs(ows As Worksheet, sFolderPath As String, sExtension As String, sRangeName As String)
Dim rng As Range
Dim cht
Set rng = ows.Range(sRangeName)
rng.CopyPicture xlScreen, xlPicture
Set cht = ows.ChartObjects.Add(0, 0, rng.Width, rng.Height)
'adding a breakpoint to line just below this one will result in the function working
With cht
.chart.Paste
.chart.Export sFolderPath & sRangeName & "." & sExtension
.Delete
End With
End Sub
Related
I'm trying to perform a VLOOKUP in VBA, using a table in a different workbook.
I've tried:
width = Application.VLookup(code, Workbooks("T:\Data\Dimensions.xlsx").Sheets("Main").Range("A61:G1500"), 7, False)
where code is a variable I've already set, but it just returns "Subscript out of range".
I'm sure you can see what I'm trying to do, but I'm guessing I've got the syntax wrong in the vlookup.
Thanks.
Make sure the target workbook is opened. Try this:
Set src = Workbooks.Open("T:\Data\Dimensions.xlsx")
width = Application.VLookup(code, src.Sheets("Main").Range("A61:G1500"), 7, False)
The code below is a little long, but it will work you through step-by-step, defining and setting all your objects (see comments in the code itself).
You also need to handle a scenario where Vlookup will not be able to find code in your specified Range,
Code
Option Explicit
Sub VlookupClosedWorkbook()
Dim Width, code
Dim WorkbookName As String
Dim WB As Workbook
Dim Sht As Worksheet
Dim Rng As Range
WorkbookName = "Dimensions.xlsx"
' set the workbook object
On Error Resume Next
Set WB = Workbooks(WorkbookName) ' first try to see if the workbook already open
On Error GoTo 0
If WB Is Nothing Then ' if workbook = Nothing (workbook is closed)
Set WB = Workbooks.Open("T:\Data\" & WorkbookName)
End If
' set the worksheet object
Set Sht = WB.Sheets("Main")
' set the Range object
Set Rng = Sht.Range("A61:G1500")
' verify that Vlookup found code in the Range
If Not IsError(Application.VLookup(code, Rng, 7, False)) Then
Width = Application.VLookup(code, Rng, 7, False)
Else
MsgBox "Vlookyp Error finding " & code
End If
End Sub
You have to open that workbook or use cell to get value from closed one
range("A1").formula = "=vlookup(" & code & ",'T:\Data\[Dimensions.xlsx]Main'!A61:G1500,7,0)"
range("A1").calculate
width = range("A1").value
Using Excel 2007, I understand that I can create worksheet_change event on the worksheet it's created.
But how do I assign a global sub change events to a newly created worksheet?
e.g.
Public Sub DataChange(ByVal Target As Range)
' this will check and see if the user or operator has change the column field
' if they fill in "X", mark the whole row to red color
' otherwise leave it black
Dim KeyCells As Range
Dim LastRow As Long
LastRow = Cells(Rows.Count, 1).END(xlUp).Row
Set KeyCells = Range("L2:L" & LastRow)
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
If Target.Value = "X" Or Target.Value = "x" Then
Target.EntireRow.Font.color = vbRed
Else
Target.EntireRow.Font.color = vbBlack
End If
End If
End Sub
Then in a separate sub procedure in Module1...
Public Sub CreateWorkSheet()
Dim ws As Worksheet
Set ws = Sheets.Add
ws.Name = "Test1"
' Here where I want to set the event but I do not know the syntax
' ws.OnChange = DataChange
Debug.Print "Done"
End Sub
I'm used to assign events on the fly when creating controls (C#/WPF/Pascal), so I figured there would be one in Excel world. Any advice or help would be greatly appreciated.
As mentioned by Jeeped, probably the easiest way would be to copy the sheet that already had the Private Sub Worksheet_Change code behind it, but there is also another way, if you place the following code under ThisWorkbook, whenever a new sheet is created it will add the desired code behind it:
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim NewSheet As Worksheet
Set NewSheet = Sheets(ActiveSheet.Name)
Code = "Private Sub Worksheet_Change(ByVal Target As Range)" & vbCrLf
Code = Code & "MsgBox ""your code here""" & vbCrLf
Code = Code & "End Sub"
With ThisWorkbook.VBProject.VBComponents(NewSheet.Name).CodeModule
NextLine = .CountOfLines + 1
.InsertLines NextLine, Code
End With
End Sub
The drawback here is that the Trust Settings for Macros would need to be changed by clicking on the Trust access to the VBA project object model:
EDIT:
You could also copy code from one worksheet to another using a similar method:
Sub test()
Dim CodeCopy As VBIDE.CodeModule
Dim CodePaste As VBIDE.CodeModule
Dim numLines As Long
Set CodeCopy = ActiveWorkbook.VBProject.VBComponents("Sheet1").CodeModule
Set CodePaste = ActiveWorkbook.VBProject.VBComponents("Sheet2").CodeModule
numLines = CodeCopy.CountOfLines
'Use this line to erase all code that might already be in sheet2
'If CodePaste.CountOfLines > 1 Then CodePaste.DeleteLines 1, CodePaste.CountOfLines
CodePaste.AddFromString CodeCopy.Lines(1, numLines)
End Sub
I'd go for the last #Jeeped's suggestion
place this code in ThisWorkbook code pane
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
DataChange Target ' this sub will be called at any change of any worksheet passing the chenged range
End Sub
then place this in the same code pane or in any other Module
Public Sub DataChange(ByVal Target As Range)
' this will check and see if the user or operator has change the column field
' if they fill in "X", mark the whole row to red color
' otherwise leave it black
Dim KeyCells As Range
Set KeyCells = Range("L2:L" & Cells(Rows.Count, 1).End(xlUp).Row)
If Not Application.Intersect(KeyCells, Target) Is Nothing Then Target.EntireRow.Font.color = IIf(UCase(Target.Value2) = "X", vbRed, vbBlack)
End Sub
I' trying to automate the generation of small-sized screenshots directly from excel sheet by clicking a button with VBA code in the background. Here is the situation:
I have to take screenshot of cellrange G1:I12, and save it in a filename
called scrt.png. The size of the screenshot should remain exactly the same as that of cellrange G1:I12
From one of the earlier posts, I found this code which seems to work by first including the screenshot of the mentioned range to a new ChartSheet, and then it saves the scrt.png file at the mentioned location successfully. In essence, it successfully generates a bitmap of the selected cell range in the ChartSheet, and also generates the seperate scrt.png file at the mentioned location.
However, the problem with the code is that the scrt.png file that is created is having the whole ChartSheet screenshot. What I am looking for only the file saved with mentioned cell range snap.
Have tried to tweak the code, but no success. Any help will be greatly appreciated.
Sub Macro1()
myFileName = "scrt.png"
Range("G1:I12").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
Charts.Add
ActiveChart.Paste
ActiveChart.Export Filename:=ThisWorkbook.Path & "\" & myFileName, Filtername:="PNG"
End Sub
Thanks a lot.
Instead of using a Chart sheet, use an embedded chartObject on a regular worksheet - then you can resize it before pasting in the copied range picture
Sub Tester()
ExportRange Selection, "C:\_Stuff\test\scrt.png"
End Sub
Sub ExportRange(rng As Range, sPath As String)
Dim cob, sc
rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
Set cob = rng.Parent.ChartObjects.Add(10, 10, 200, 200)
'remove any series which may have been auto-added...
Set sc = cob.Chart.SeriesCollection
Do While sc.Count > 0
sc(1).Delete
Loop
With cob
.Height = rng.Height
.Width = rng.Width
.Chart.Paste
.Chart.Export Filename:=sPath, Filtername:="PNG"
.Delete
End With
End Sub
I actually create worksheets programmatically and add button with a macro associated to these worksheets programmatically. What I want to do is that when I click on the button the content of the worksheet containing the button is copied to another worksheet.
There are actually two things that confuse me : Firstly I don't understand if the macro I associate to the button is located (I mean its code is located) in the file creating the worksheet or in the created worksheet itself.
Here is the code I create to add a button with an associated macro :
With newWorkBook.Worksheets(1).Buttons
.Add 350, 75, 173.25, 41.25
.OnAction = "'" & ThisWorkbook.FullName & "'!export_Click"
.Caption = "Exporter la fiche"
End With
newWorkBook.Worksheets("Feuil1").Name = "Valeurs"
The checkPVC_Click Sub is in a module located in the Excel file used to generate the worksheets.
Secondly, within the macro that is supposed to copy the content of a worksheet to another, I don't know how to refer differently to the two worksheets (source and target) in the code.
In the code below :
Dim newWorkBook As Workbook
Dim createdSheetColumnsTab(100) As String
Dim col As Integer
col = Cells(1, 8).Value
Set newWorkBook1 = Workbooks.Add
newWorkBook1.Worksheets("Feuil1").Cells(1, 1).Value = "Stat"
newWorkBook1.Worksheets("Feuil1").Cells(2, 1) = ActiveWorkbook.Worksheets("Valeurs").Cells(12, 1)
Here in the line col = Cells(1, 8).Value I access to the content of the worksheet which content I want to copy, and in the line newWorkBook1.Worksheets("Feuil1").Cells(1, 1).Value = "Stat" I access to the content of the "target" worksheet and I don't know how to refer to the content of the first worksheet in the following of the code in order to copy the content.
I hope I was clear, and I can add more precisions if necessary, sorry I don't master English so it's hard for me to explain the issue.
You can leave the Sub checkPVC_Click in the original workbook. Just ensure that you give full path and name of the file which has that macro. For example. Please ensure that the file from where you are running this macro is saved at least once.
Sub Sample()
Dim NewWorkbook As Workbook
Set NewWorkbook = Workbooks.Add
With NewWorkbook.Worksheets(1).Buttons
.Add 350, 15, 173.25, 41.25
.OnAction = "'" & ThisWorkbook.FullName & "'!checkPVC_Click"
End With
End Sub
Sub checkPVC_Click()
MsgBox "a"
End Sub
Regarding your Second question, you need to fully qualify the Cells object so that it know which cells are you referring to
ThisWorkbook will refer to the cell from the workbook which hosts the code.
Activeworkbook will refer to the cell from the workbook which is currently active.
Edit: Followup from comments. Is this what you are trying?
Sub Sample()
Dim newWorkBook As Workbook
Dim ws As Worksheet
Set newWorkBook = Workbooks.Add
Set ws = newWorkBook.Sheets(1)
ws.Name = "Valeurs"
With ws.Buttons
.Add 350, 15, 173.25, 41.25
.OnAction = "'" & ThisWorkbook.FullName & "'!checkPVC_Click"
End With
End Sub
Sub checkPVC_Click()
Dim OldWorkbook As Workbook, newWorkBook As Workbook
Dim createdSheetColumnsTab(100) As String
Set OldWorkbook = ActiveWorkbook
Set newWorkBook1 = Workbooks.Add
newWorkBook1.Worksheets("Feuil1").Cells(1, 1).Value = "Stat"
newWorkBook1.Worksheets("Feuil1").Cells(2, 1) = OldWorkbook.Worksheets("Valeurs").Cells(12, 1)
End Sub
To access the content of the first worksheet of workbook containing macro you need to use:
Thisworkbook.sheets(1).range("a1:a100") ' range as an example you can input anything
Hope it helped.
First time poster, been searching for a solution to this all over but no luck yet.
To explain my problem:
TERMS:
OPC = Object Linking and Embedding (OLE) for Process Control
(allows other applications to use data from PLC tags)
PLC = Programmable Logic Controller (computer for process control
SCADA = Supervisory Control And Data Acquisition (interface that displays values from PLC and allows control)
I have an excel workbook which is automatically opened by the SCADA system (WonderWare > Intouch, the software) at a specific time after the PLC has sorted some values. This workbook populates its cells using the OPC client, accessing them using this method:
=OPCLINK|EAST!'r[BELLWWPOWER]DailyValues_Z3[1,21]'
This works well but there are a lot of cells to populate so it takes a few seconds.
What I want to automatically happen is for these cells to populate and any calculations to complete before all the cells with formulas are changed to just the values of those formulas. The workbook is then saved under a new workbook name ("PowerReports-YesterdaysDate") with the VBA code stripped and both workbooks are closed (without saving the original, to preserve formulas).
This all works well except it happens too fast and the new saved copy ends up having just "#N/A" in all the cells with OPC links. When I had the first sheet's private sub as "Worksheet_Activate()" instead of "Worksheet_Calculate()", the code wouldn't stat automatically and waited for a mouse click onto one of the sheet's cells (FYI: the SCADA system opens this workbook to sheet 1 automatically to start with sheet 1's code). The new copy would save successfully in this case, but when the code stats automatically it is too fast. How can I wait for the external data to load before the calculations are done?
I've tried things (I don't know how successfully they were implemented..) like:
-Application.Calculate
-Application.RefreshAll
-Timers
-Trying to get a flag from the PLC
-Checking for remaining #N/As
It seems like if a loop or something similar is running right away it doesn't let the external data refresh.
Private Sub Worksheet_Calculate()
' When first sheet "Main" is activated, all formulas are replaced
' with their calculated values. The second sheet, "Monthly Values" is then activated
Dim rng As Range, r As Range
Set rng = Range("A1:D52")
For Each r In rng
If r.HasFormula Then
r.Value = r.Value
End If
Next r
Worksheets("Monthly Data").Activate
End Sub
Private Sub Worksheet_Activate()
' When second sheet "Monthly Values" is activated, all formulas are replaced
' with their calculated values. The sub routine, "SaveWithoutMacros" is then called
Dim rng As Range, r As Range
Set rng = Range("A1:BJ84")
'Worksheets("Monthly Data").Calculate
'If Not Application.CalculationState = xlDone Then
'DoEvents
'End If
For Each r In rng
If r.HasFormula Then
r.Value = r.Value
End If
Next r
Call SaveWithoutMacros
End Sub
Sub SaveWithoutMacros()
'Purpose : To save a copy of the active workbook without macros
Dim vFilename As String
Dim wbActiveBook As Workbook
'----------------------------------------------------------------------
'Following two lines causes an error in Excel 97 - comment them out
Dim VBComp As VBIDE.VBComponent
Dim VBComps As VBIDE.VBComponents
'----------------------------------------------------------------------
' Save to filename in format (yesterdays date) "PowerReports-DD-MM-YYYY"
vFilename = ("D:\PowerReports\" & "PowerReport-" _
& Format(Date - 1, "DD-MMM-YYYY") & ".xls")
ActiveWorkbook.SaveCopyAs vFilename
Set wbActiveBook = Workbooks.Open(vFilename)
'Now strip all VBA, modules, userforms from the copy
'This code is from Chip Pearson's website http://www.cpearson.com
Set VBComps = wbActiveBook.VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case vbext_ct_StdModule, vbext_ct_MSForm, vbext_ct_ClassModule
VBComps.Remove VBComp
Case Else
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next VBComp
wbActiveBook.Save ' saves new version after code is stripped
ThisWorkbook.Saved = True ' sets save flag to true, does not actually save
Application.Quit ' quits entire application, all workbooks
End Sub
Sorry for the lengthy post, saw other people getting ripped on for not being detailed enough, haha.
This should work for you now , by testing only the last cell being filled in then you will be sure all the data is in before you change them to values
Were basically telling worksheet_calculate to do nothing until the last cell has a formula
NOTE : SEE OP ANSWER BELOW FOR MODIFIED CODE THAT WORKED IN THIS SCADA SITUATION
Private Sub Worksheet_Calculate()
Dim rngLastCell As Range
Set rngLastCell = Range("D52")
If rngLastCell.HasFormula Then
Dim rng As Range, r As Range
Set rng = Range("A1:D52")
For Each r In rng
If r.HasFormula Then
r.Value = r.Value
End If
Next r
Worksheets("Monthly Data").Activate
End If
End Sub
Ended up getting it! Thanks to Steven Martin for giving me a jump off point to get this working, until you you posted your answer I didn't think an if statement would work for me here without a loop.
This is what worked for me:
Private Sub Worksheet_Calculate()
Dim rngLastCell As Range
Set rngLastCell = Range("D52")
If WorksheetFunction.IsNA(rngLastCell) = False Then
Dim rng As Range, r As Range
Set rng = Range("A1:D52")
For Each r In rng
If r.HasFormula Then
r.Value = r.Value
End If
Next r
Worksheets("Monthly Data").Activate
End If
End Sub
And then the same IF statement checking for "#N/A" in the 2nd sheet's code too, works like a charm now.