on MAC OFFICE 2011 I am trying to get this working: http://www.contextures.com/xlDataVal10.html
There is a sample file that you can download: http://www.contextures.com/DataValCombobox.zip
But when I open the worksheet and click on a cell I get the following error:
"Method or data member not found"
Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
If cboTemp.Visible = True Then
With cboTemp
.Top = 10
.Left = 10
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
.Value = "" <<<- HIGHLIGHTED
End With
End If
The debugger highlights the .value as indicated above.
What is the cause of this and can it be fixed ?
It's because .Value isn't a property of the ComboBox.
Here is the list of properties you can use.
You are probably looking for
.SelectedValue
or Depending on which column you have the Rowsource bound.
.SelectedIndex
You can also use
.Text
Related
A little background:
A former employee wrote a VBA program to run in AutoCAD to generate G-code based off of CAD entities. The immediate problem is that it currently only runs in AutoCAD 2002 on a computer running Windows XP on a virtual desktop. Obviously, that doesn't work so I'm trying to get it to work on BricsCad V21. My current issue is that I keep getting a Run time error 91 at the following place and I do not understand what the issue is or how to overcome it.
Please note that I am a VERY beginner programmer and am still trying to wrap my head around how all of this works. Any help you can provide would be most appreciated.
Public ExcelApp As Excel.Application
Public wbkObj As Excel.Workbook
Public shtObj As Excel.Worksheet
Public rngObj As Excel.Range
These are the relevant declarations at the beginning of the program
Sub CAM_A_CHEST()
Set ExcelApp = CreateObject("Excel.Application")
Set wbkObj = ExcelApp.workbooks.Add
Set shtObj = ExcelApp.Worksheets(1)
If Err <> 0 Then
MsgBox "Could not start Excel", vbExclamation
End
Else
ExcelApp.Visible = True
Application.Visible = True
ExcelApp.ScreenUpdating = True
Set rngObj = shtObj.Range(Cells(1, 1), Cells(1, 5))
With rngObj
.NumberFormat = "0"
.Font.Name = "Arial"
.Font.FontStyle = "Bold"
.Font.Size = 10
'.Font.ColorIndex = xlAutomatic
End With
With shtObj.Range(Cells(2, 1), Cells(2000, 13))
.NumberFormat = "0.000"
.Font.Name = "Arial"
.Font.FontStyle = "Regular"
.Font.Size = 9
.Value = ""
End With
With shtObj.Range(Cells(2, 5), Cells(2000, 5))
.NumberFormat = "0"
End With
shtObj.Range("A1:D1").Select
Selection.NumberFormat = "General"
shtObj.Cells(1, 1).ColumnWidth = 18
shtObj.Cells(1, 1) = "Layer"
shtObj.Cells(1, 2) = "Center X"
shtObj.Cells(1, 3) = "Center Y"
shtObj.Cells(1, 4) = "Diameter"
shtObj.Cells(1, 5) = "Sort"
shtObj.Cells(1, 7).Font.FontStyle = "Bold"
shtObj.Cells(1, 7).Font.Size = 10
Range("A2").Select
ActiveWindow.FreezePanes = True
End If
'ExcelApp.Visible = False
transZ$ = "2.00"
divNum$ = ""
grpNum$ = "0"
Load UserForm1
Load UserForm2
Load UserForm3
Load procUserForm
Call UserForm_Initialize
That is the chunk of code that opens Excel, formats the Worksheet, and prepares for inputs from AutoCAD. Later on in the code, The following Sub is called:
Sub CAM_TopAndBottomBoards()
Dim I As Integer
Dim mspaceObj As AcadObject
Dim centerPoint As Variant
Dim ExcelApp As Excel.Application
increment = 0
Call InitializeCounters
SelectStuff:
'Find entities representing Pitman Holes, Pipe Holes, etc., among items selected,
' dump data into Excel sheet
ExcelApp.Visible = True
It's that last line that is generating the error.
At this point I've spent a couple of days on this issue and I'm completely stuck. Help!
I have managed with input the textbox to the formula, as per the following query, which I raised a while ago...
VBA Excel how to write Excel formula in the textbox
and everything is fine, but I have got problems with input the proper font features into this textbox.
Basically I have two separate sets of code, which I would love to combine into the one
Sub Duct1()
Set myDocument = ActiveSheet
With myDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 140, 180, 30)
.name = "Duct1"
With .TextFrame
.HorizontalAlignment = xlLeft
With .Characters
.Text = "1W-20mm/90' upturn"
.Font.ColorIndex = 3
.Font.Size = 16
.Font.Bold = True
End With
End With
.Rotation = 25
.Fill.Visible = False
.Line.Visible = False
End With
End Sub
Sub Duct1Desc()
ActiveSheet.Shapes("Duct1").OLEFormat.Object.Formula = "=AB1"
End Sub
For the second code I tried also:
Sub Duct1Desc()
ActiveSheet.Shapes("Duct1").OLEFormat.Object.Formula = "=AB1"
With ActiveSheet.Shapes("Duct1")
.Font.ColorIndex = 3
.Font.Size = 16
.Font.Bold = True
End With
End Sub
But in this issue I have got an error, that VBA doesn't support this property or method.
Can anyone help me to bind these 2 codes together?
Thanks
This works for me:
Dim s As Shape
Set s = ActiveSheet.Shapes("myBox")
s.DrawingObject.Formula = "=B2"
OK I thought the problem was the linking, not the formatting: this works for me.
Sub Duct1Desc()
Dim s
Set s = ActiveSheet.Shapes("Duct1")
s.OLEFormat.Object.Formula = "=A1"
With s.DrawingObject
.Font.ColorIndex = 3
.Font.Size = 20
.Font.Bold = True
End With
End Sub
Task:
I work in Excel2013. I tried to write in VBA a userform to add parameters into dynamic named ranges. All named ranges are held in one sheet and were created using insert>table. I select the range, show existing values and get the new value. All went well untill I actually got to adding value to the range.
Problem:
Excel shuts down most of the time when I try to run the UserForm. Saying:
"Run-time error '-2147417848 (80010108)' Method X of object 'Range' failed"
with different methods ('_Default' last time I checked) at different stages of me breaking code down.
Symtoms:
After this line as I found I get the error:
Cells(y, x) = v
where y and x are integers and v a string I get from the userform. During the debug I checked all values are defined and have values. Moreover, Immediate window with the same numbers input manually (not as variables), works!
It mostly doesn't work, though it did follow through doing the job.
If somone could tell the reason why it breaks it would be greatly appreciated!
Some of the captions and potential values are in Unicode in case it matters, though I tried putting it all in English as well.
Private Sub UserForm_Initialize()
' Preparing all controls of UserForm
Sheet2.Activate
Me.LB_parameter.SetFocus
Me.LB_parameter.value = ""
Me.LB_elements.RowSource = ""
Me.L_element.Enabled = False
Me.TB_element.Enabled = False
Me.TB_element.Locked = True
Me.Btn_Add.Enabled = False
Me.Btn_Add.Locked = True
End Sub
Private Sub LB_parameter_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
' Filling the existing list of values for the selected parametr
If Me.LB_parameter.value <> "" Then
Me.LB_elements.RowSource = "D_" & Me.LB_parameter.value & "s"
Me.L_element.Enabled = True
Me.TB_element.Enabled = True
Me.TB_element.Locked = False
Me.TB_element.SetFocus
End If
End Sub
Private Sub TB_element_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
' Catching the event of filling out the potential new value
Me.Btn_Add.Enabled = True
Me.Btn_Add.Locked = False
Me.L_element.Enabled = False
Me.TB_element.Enabled = False
Me.TB_element.Locked = True
End Sub
Private Sub Btn_Add_Click()
If Me.TB_element.Text = "" Then
' Check if Empty
MsgBox ("Âû íå âïèñàëè çíà÷åíèå!")
' Reset the UserForm
Me.Btn_Add.Enabled = False
Me.Btn_Add.Locked = True
Me.L_element.Enabled = True
Me.TB_element.Enabled = True
Me.TB_element.Locked = False
Me.TB_element.SetFocus
Else
' check if exists
Dim str
For Each str In range("D_" & Me.LB_parameter.value & "s")
If Me.TB_element.Text = str Then
MsgBox ("Ââåäåííîå çíà÷åíèå óæå ñóùåñòâóåò!")
' reset the UserForm
Me.Btn_Add.Enabled = False
Me.Btn_Add.Locked = True
Me.L_element.Enabled = True
Me.TB_element.Enabled = True
Me.TB_element.Locked = False
Me.TB_element.SetFocus
Me.TB_element.value = ""
Exit Sub
End If
Next str
' add to the range here
Dim x As Integer, y As Integer, v As String
y = range("D_" & Me.LB_parameter.value & "s").Rows.Count + 2
x = Me.LB_parameter.ListIndex + 1
v = Me.TB_element.value
' Next line causes break down
Cells(y, x) = v
MsgBox ("Âû äîáàâèëè ýëåìåíò:'" & v & "' äëÿ ïàðàìåòðà '" & Me.LB_parameter.value & "'.")
' Reset the Userform
Me.LB_parameter.SetFocus
Me.LB_parameter.value = ""
Me.LB_elements.RowSource = ""
Me.L_element.Enabled = False
Me.TB_element.Enabled = False
Me.TB_element.Locked = True
Me.Btn_Add.Enabled = False
Me.Btn_Add.Locked = True
End If
End Sub
Sheet I add values to the parametrs and namedranges window:
The UserForm layout:
Cells(y, x) = v
This call is shorthand for this:
ActiveSheet.Cells(y, x).Value = v
I'm not sure why it's crashing on you, but the _Default property of a Range object being its Value, what I'd try here is being more explicit about what I'm trying to achieve, namely:
Exactly which Worksheet is supposed to get modified?
Exactly which Range is being referred to?
I very very very seldom work with ActiveSheet - most of the time I know exactly what object I'm working with. Try using an object. You can create a new one:
Dim target As Worksheet
Set target = ThisWorkbook.Worksheets("pl")
...Or you can give the sheet a code name in the properties toolwindow (F4):
That (Name) property defines an identifier that you can use in VBA code to access a global-scope object that represents that specific worksheet. Assuming that's Sheet1, you could do this:
Sheet1.Cells(x, y) = v
If that still fails, then you can be even more specific about the Range object you're accessing and the property you're setting:
Dim target As Range
Set target = Sheet1.Cells(x, y)
target.Value = v
Normally that wouldn't make a difference though. But I see you're making Range calls, which are also implicitly calling into the ActiveSheet.
I'd start by eliminating these, and working off an explicit object reference.
Then I'd work on getting the spreadsheet logic out of the form; that button click handler is doing way too many things - but I digress into Code Review territory - feel free to post your code there when you get it to work as intended!
Looks like the problem lies in my version of Excel. Not sure if the problem is in my copy or in the 2013 in general. In Excel 2007 on the same machine the UserForm with given suggestions worked continuously without any errors at all! Will update in comments later as I try it in different versions.
I created a macro in Excel 2010, that works quite fine when called from the Macros dialog or the VB window. All's fine at that point. Now, I tried my hand at customized ribbons, and used Custom UI Editor to create a new tab, with custom icons to call my macro. And it's not fine.
The call to the macro works, the macro seems to run properly, scanning each sheet as it should, looking for comments and acting on them, but when it's completed, almost none of the comments were modified as they should have been.
And that's my issue: when I run the macro "normally", it works as planned, it's only when I try to call it from its custom icon that it doesn't do what it's supposed to do (while still seeming to when clicked).
Anyone has an idea what could be wrong?
I don't think it's the code, as I said, it works fine when called from Macros or the VB window
Edit: As I said, I don't think the code is the problem, as it executes without error (it just doesn't do what it's supposed to), but as requested, I post it here:
Sub ImportCommentsFromWord(control As IRibbonControl)
Dim xComment As Comment
Dim xSheet As Worksheet
Dim wApp As Object
'Opens Word if not already open
On Error Resume Next
Set wApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Err.Clear
Set wApp = CreateObject("Word.Application")
End If
wApp.Visible = False
For Each xSheet In ActiveWorkbook.Worksheets
'Activates each sheet one after another
xSheet.Activate
sName = xSheet.Name
expName = Application.ActiveWorkbook.Path + "\" + sName + ".docx"
'Checks if there are comments in active sheet
For Each xComment In xSheet.Comments
CommsInSheet = 1
Next
If CommsInSheet = 1 Then
'Opens the translated document to import comments into the sheet
wApp.Documents.Open (expName)
wApp.Selection.ClearFormatting
wApp.Selection.Find.MatchWildcards = False
wApp.Selection.WholeStory
wApp.Selection.MoveLeft
FileEnd = 0
'Imports comments until end of file is reached
While FileEnd = 0
wApp.Selection.ExtendMode = True
wApp.Selection.MoveRight
With wApp.Selection.Find
.Text = "^l"
End With
wApp.Selection.Find.Execute
DestCell = Mid(wApp.Selection.Text, 2, Len(wApp.Selection.Text) - 2)
wApp.Selection.ExtendMode = False
wApp.Selection.MoveRight
wApp.Selection.ExtendMode = True
With wApp.Selection.Find
.Text = "^l"
End With
wApp.Selection.Find.Execute
wApp.Selection.ExtendMode = False
DestComm = Left(wApp.Selection.Text, Len(wApp.Selection.Text) - 1)
wApp.Selection.MoveRight
wApp.Selection.MoveLeft
wApp.Documents.Add DocumentType:=0
wApp.Selection.Text = DestComm
With wApp.Selection.Find
.Text = "^p"
.Replacement.Text = Chr(10)
End With
wApp.Selection.Find.Execute Replace:=wdReplaceAll
wApp.Selection.WholeStory
DestComm = Left(wApp.Selection.Text, Len(wApp.Selection.Text) - 1)
wApp.ActiveDocument.Close savechanges:=False
If Right(DestComm, 11) = "END_OF_FILE" Then
DestComm = Left(DestComm, Len(DestComm) - 11)
FileEnd = 1
End If
xSheet.Range(DestCell).Comment.Text Text:=DestComm
Wend
'Closes the Word document
wApp.ActiveDocument.Close savechanges:=False
End If
CommsInSheet = 0
Next
wApp.Visible = True
Set wApp = Nothing
End Sub
Never mind, I found the solution myself: the issue was in the xml code of the customized ribbon, it was calling the wrong macro, so of course it didn't work as expected...
I'm adding ".jpg" files to my Excel sheet with the code below :
'Add picture to excel
xlApp.Cells(i, 20).Select
xlApp.ActiveSheet.Pictures.Insert(picPath).Select
'Calgulate new picture size
With xlApp.Selection.ShapeRange
.LockAspectRatio = msoTrue
.Width = 75
.Height = 100
End With
'Resize and make printable
With xlApp.Selection
.Placement = 1 'xlMoveAndSize
'.Placement = 2 'xlMove
'.Placement = 3 'xlFreeFloating
.PrintObject = True
End With
I don't know what I am doing wrong but it doesn't get inserted into the right cell, so what should I do to put this picture into a specified cell in Excel?
Try this:
With xlApp.ActiveSheet.Pictures.Insert(PicPath)
With .ShapeRange
.LockAspectRatio = msoTrue
.Width = 75
.Height = 100
End With
.Left = xlApp.ActiveSheet.Cells(i, 20).Left
.Top = xlApp.ActiveSheet.Cells(i, 20).Top
.Placement = 1
.PrintObject = True
End With
It's better not to .select anything in Excel, it is usually never necessary and slows down your code.
Looking at posted answers I think this code would be also an alternative for someone. Nobody above used .Shapes.AddPicture in their code, only .Pictures.Insert()
Dim myPic As Object
Dim picpath As String
picpath = "C:\Users\photo.jpg" 'example photo path
Set myPic = ws.Shapes.AddPicture(picpath, False, True, 20, 20, -1, -1)
With myPic
.Width = 25
.Height = 25
.Top = xlApp.Cells(i, 20).Top 'according to variables from correct answer
.Left = xlApp.Cells(i, 20).Left
.LockAspectRatio = msoFalse
End With
I'm working in Excel 2013. Also realized that You need to fill all the parameters in .AddPicture, because of error "Argument not optional". Looking at this You may ask why I set Height and Width as -1, but that doesn't matter cause of those parameters are set underneath between With brackets.
Hope it may be also useful for someone :)
If it's simply about inserting and resizing a picture, try the code below.
For the specific question you asked, the property TopLeftCell returns the range object related to the cell where the top left corner is parked. To place a new image at a specific place, I recommend creating an image at the "right" place and registering its top and left properties values of the dummy onto double variables.
Insert your Pic assigned to a variable to easily change its name. The Shape Object will have that same name as the Picture Object.
Sub Insert_Pic_From_File(PicPath as string, wsDestination as worksheet)
Dim Pic As Picture, Shp as Shape
Set Pic = wsDestination.Pictures.Insert(FilePath)
Pic.Name = "myPicture"
'Strongly recommend using a FileSystemObject.FileExists method to check if the path is good before executing the previous command
Set Shp = wsDestination.Shapes("myPicture")
With Shp
.Height = 100
.Width = 75
.LockAspectRatio = msoTrue 'Put this later so that changing height doesn't change width and vice-versa)
.Placement = 1
.Top = 100
.Left = 100
End with
End Sub
Good luck!
I have been working on a system that ran on a PC and Mac and was battling to find code that worked for inserting pictures on both PC and Mac. This worked for me so hopefully someone else can make use of it!
Note: the strPictureFilePath and strPictureFileName variables need to be set to valid PC and Mac paths Eg
For PC: strPictureFilePath = "E:\Dropbox\" and strPictureFileName = "TestImage.jpg" and with Mac: strPictureFilePath = "Macintosh HD:Dropbox:" and strPictureFileName = "TestImage.jpg"
Code as Follows:
On Error GoTo ErrorOccured
shtRecipeBrowser.Cells(intDestinationRecipeRowCount, 1).Select
ActiveSheet.Pictures.Insert(Trim(strPictureFilePath & strPictureFileName)).Select
Selection.ShapeRange.Left = shtRecipeBrowser.Cells(intDestinationRecipeRowCount, 1).Left
Selection.ShapeRange.Top = shtRecipeBrowser.Cells(intDestinationRecipeRowCount, 1).Top + 10
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 130
Firstly, of all I recommend that the pictures are in the same folder as the workbook.
You need to enter some codes in the Worksheet_Change procedure of the worksheet. For example, we can enter the following codes to add the image that with the same name as the value of cell in column A to the cell in column D:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim pic As Picture
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
On Error GoTo son
For Each pic In ActiveSheet.Pictures
If Not Application.Intersect(pic.TopLeftCell, Range(Target.Offset(0, 3).Address)) Is Nothing Then
pic.Delete
End If
Next pic
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Target.Value & ".jpg").Select
Selection.Top = Target.Offset(0, 2).Top
Selection.Left = Target.Offset(0, 3).Left
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = Target.Offset(0, 2).Height
Selection.ShapeRange.Width = Target.Offset(0, 3).Width
son:
End Sub
With the codes above, the picture is sized according to the cell it is added to.
Details and sample file here : Vba Insert image to cell
I tested both #SWa and #Teamothy solution. I did not find the Pictures.Insert Method in the Microsoft Documentations and feared some compatibility issues. So I guess, the older Shapes.AddPicture Method should work on all versions. But it is slow!
On Error Resume Next
'
' first and faster method (in Office 2016)
'
With ws.Pictures.Insert(Filename:=imageFileName, LinkToFile:=msoTrue, SaveWithDocument:=msoTrue)
With .ShapeRange
.LockAspectRatio = msoTrue
.Width = destRange.Width
.height = destRange.height '222
End With
.Left = destRange.Left
.Top = destRange.Top
.Placement = 1
.PrintObject = True
.Name = imageName
End With
'
' second but slower method (in Office 2016)
'
If Err.Number <> 0 Then
Err.Clear
Dim myPic As Shape
Set myPic = ws.Shapes.AddPicture(Filename:=imageFileName, _
LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
Left:=destRange.Left, Top:=destRange.Top, Width:=-1, height:=destRange.height)
With myPic.OLEFormat.Object.ShapeRange
.LockAspectRatio = msoTrue
.Width = destRange.Width
.height = destRange.height '222
End With
End If