Could someone help me please? Thank you!!!!!
I have a Excel user form for supervisors to assign tasks. it has a bar chart on it to show how many items assigned to team member. the goal is to help the supervisor see how many items he assigns to each person. It works perfectly fine on my computer, but if I share it on a shared drive, my coworkers can open and use it, but the bar chart won't show. it should look like the picture.
the code is
Private Sub Assign_Invoice_cmb_AssignTo_Change()
Application.ScreenUpdating = False
Dim i As Integer
Dim RowNumber As Integer
Dim AssignChart As String
For i = 0 To Assign_Invoice_lb_Invoice.ListCount - 1
If Assign_Invoice_lb_Invoice.Selected(i) Then
Assign_Invoice_lb_Invoice.List(i, 7) = Assign_Invoice_cmb_AssignTo.Value
RowNumber = i + 15
Assign_Invoice_lb_Invoice.Selected(i) = False
End If
Next i
Call AssignInformation(Sheet2.Range("CD12").Value, Assign_Invoice_lb_Invoice, Sheet2.Range("CD9").Value, Assign_Invoice_lbl_Assigned, Assign_Invoice_lbl_NotAssigned)
Call EmbedChart("AssignChart", Assign_Invoice_img_AssignQty)
Application.ScreenUpdating = True
End Sub
Sub EmbedChart(ChartName As String, MyImage As MSForms.Image)
Dim Cname As Chart
Dim Fname As String
Fname = ThisWorkbook.Path & "\temp.gif"
Set Cname = Sheet2.ChartObjects(ChartName).Chart
Sheet2.ChartObjects(ChartName).Activate
Cname.Export Filename:=Fname, filtername:="GIF"
MyImage.Picture = LoadPicture(Fname)
End Sub
This might be due to an access issue. If the user opening it doesn't have read/write access on the shared drive, the program would not be able to save the chart image and/or wouldn't be able to display it.
Related
Edit : Sorry i forgot to mention that is VBA for Excel
First time i post on this sub reddit. I would like to something very simple, yet I have no heckin idea how to do it.
Let me give you a bit of context : In my company we have a standard model tool, which uses a standard excel file as input.
When you want to update your inputs from an old template, you download a standard file from a platform, and use a sub that doesn't take any arguments (called "upgrade engine"). Wen you call Upgrade engine, there is a file dialog tab that opens, and helps you select the source file you want to upgrade.
I am in a testing team for the standard model and i have to create a lot of templatse for each new release of the model for non regression testing purpose. So i would like to automatize the process. I cannot , and this is the important detail here, change the code of the standard template.
So i created a kind of masterfile with all my non regression test use cases, their address etc to update them one by one.
Here is my current code:
Public gParamTab As Variant
Public gHypTab As Variant
Public gSourcefolder As String
Public gBlankFolder As String
Public gTgtfolder As String
Public Const gParamTabColUseCase As Byte = 1
Public Const gParamTabColTTtgt As Byte = 2
Public Const gParamTabColTTSource As Byte = 3
Public Const gParamTabColFlagRetrieve As Byte = 4
Public Const gParamTabColTTCase As Byte = 5
Public Const gParamTabColFlagUpgrade As Byte = 6
Public Const gBlankTTName As String = "Table_Template_MVP_case"
Public Const gExtension As String = ".xlsb"
Sub init()
gParamTab = Sheets("Parameters").Range("gParamTab")
gHypTab = Sheets("NDD HYP").Range("gHypTab")
gSourcefolder = Sheets("Parameters").Range("gSourcefolder")
gTgtfolder = Sheets("Parameters").Range("gTgtfolder")
gBlankFolder = Sheets("Parameters").Range("gBlankFolder")
End Sub
Sub updateTT()
Call init
Dim lFullname_blank As String, lFullname_source As String, lFullname_tgt As String
Dim lGlobalrange As Variant
Dim lGlobaltable() As Variant
Dim lBlankTT As Workbook
Dim lLastRow As Long
Dim lSearchedVariable As Variant
Dim lBlankTTupgradeengine As String
lcol = 2
For lUsecase = 2 To UBound(gParamTab, 1)
If gParamTab(lUsecase, gParamTabColFlagUpgrade) = 1 Then
lFullname_blank = gBlankFolder & "\" & gBlankTTName & gParamTab(lUsecase, gParamTabColTTCase) & gExtension
lFullname_source = gSourcefolder & "\" & gParamTab(lUsecase, gParamTabColTTSource) & gExtension
lFullname_tgt = gTgtfolder & "\" & gParamTab(lUsecase, gParamTabColTTtgt) & gExtension
Set lBlankTT = Workbooks.Open(lFullname_blank)
lBlankTTupgradeengine = gBlankTTName & gParamTab(lUsecase, gParamTabColTTCase) & gExtension & "!UpgradeEngine.UpgradeEngine"
Application.Run lBlankTTupgradeengine
End If
Next
End Sub
So i come the main issue, how can I, from another macro, after the statement "Application.Run lBlankTTupgradeengine" , the upgrade engine macro starts, and calls the following function embedded in the "BlankTT" :
Sub UpgradeEngine()
Set wkb_target = ThisWorkbook
Set wkb_source = macros_Fn.Open_wkb()
[...]
Function Open_wkb() As Workbook
Dim fileName As Variant
With Application.FileDialog(msoFileDialogFilePicker)
' Makes sure the user can select only one file
.AllowMultiSelect = False
' Filter to just keep the relevants types of files
.filters.Add "Excel Files", "*.xlsm; *.xlsb", 1
.Show
' Extact path
If .SelectedItems.Count > 0 Then
fileName = .SelectedItems.Item(1)
Else
End
End If
End With
If (fileName <> False) Then
Set Open_wkb = Workbooks.Open(fileName:=fileName, IgnoreReadOnlyRecommended:=False, Editable:=False, ReadOnly:=True, UpdateLinks:=False)
Else
MsgBox "This file is already open. Please close it before launching the function."
End
End If
End Function
This function opens as I said before, a dialog box with a brows button to select the excel spreadsheet to use as ssource.
My question is, how can i fill automatically this Filedialog from my code, without changing the code of the standard excel file?
Thanks a lot for your help!
I tried to search everywhere but i did not find anything about this situation.
I'm trying to move a copy of the upgrade engine, but with an argument in the sub instead of the filedialog but the macro is too complex ..
Your best bet would be to add an optional parameter to UpgradeEngine - something like:
Sub UpgradeEngine(Optional wbPath as String = "")
'...
Set wkb_target = ThisWorkbook
If Len(wbPath) > 0 Then
Set wkb_source = Workbooks.Open(wbPath) 'open using provided file path
Else
Set wkb_source = macros_Fn.Open_wkb() 'open user-selected file
End If
'...
'...
Then you can call it and pass in the path you want.
FYI the code in Open_wkb seems off (at least, the "already open" message seems wrong). fileName <> False only checks if the user made a selection: it doesn't indicate anything about whether a selected file is already open or not.
I have a macro set up to navigate through a website and scrape data + images to create a product comparison list. The small issue i'm having is that when trying to insert a picture using VBA i sometimes get a windows security prompt window to insert login details. If i cancel the window, the code works correctly but having this pop-up every product in a range of 50 items isn't ideal.
I've found a few image url's that seem to insert without this pop-up showing, which suggests to me that it's to do with how secure microsoft see's the website.
I've also tried both .Pictures.Insert and .Shapes.AddPicture. Both have the same issue
The code below using the first link will show the login window, but if you use the second link it will work without a pop-up
Sub DrawPicture()
Dim link As String
link = "https://2ecffd01e1ab3e9383f0-07db7b9624bbdf022e3b5395236d5cf8.ssl.cf4.rackcdn.com/Product-190x190/0e72ef05-691d-4b3b-b978-a1bb9929e372.jpg"
'link = "https://pbs.twimg.com/profile_images/54789364/JPG-logo-highres.jpg"
ActiveSheet.Pictures.Insert (link)
End Sub
If someone could explain and provide a solution to this issue that would be great
Try this code
Sub Test()
Dim src As String
Dim lfn As String
src = "https://2ecffd01e1ab3e9383f0-07db7b9624bbdf022e3b5395236d5cf8.ssl.cf4.rackcdn.com/Product-190x190/0e72ef05-691d-4b3b-b978-a1bb9929e372.jpg"
lfn = ThisWorkbook.Path & "\Output.jpg"
If RequestDownload(src, lfn) Then
Cells(1).Select
ActiveSheet.Pictures.Insert lfn
End If
End Sub
Function RequestDownload(URL$, FILE$) As Boolean
Dim b() As Byte
Dim f As Integer
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "GET", URL, False
.setRequestHeader "DNT", "1"
On Error GoTo Fin
.send
If .Status = 200 Then
b = .responseBody
f = FreeFile(1)
Open FILE For Binary As #f
Put #f, , b
Close #f
RequestDownload = True
End If
Fin:
End With
End Function
Have you tried the DisplayAlerts setting to Flase?
Sub DrawPicture()
Dim link As String
link = "https://2ecffd01e1ab3e9383f0-07db7b9624bbdf022e3b5395236d5cf8.ssl.cf4.rackcdn.com/Product-190x190/0e72ef05-691d-4b3b-b978-a1bb9929e372.jpg"
'link = "https://pbs.twimg.com/profile_images/54789364/JPG-logo-highres.jpg"
Application.DisplayAlerts = False
ActiveSheet.Pictures.Insert (link)
Application.DisplayAlerts = True
End Sub
I have a form that manipulates a chart and then exports it, like so:
Workbooks(sWB).Sheets("Output").Unprotect sPW
Workbooks(sWB).Sheets("Output").ChartObjects(1).Chart.Export strDocName
However, occasionally this doesn't work properly anymore and a corrupt image is exported each time. Going to the sheet with the chart and scrolling over it (without clicking) solves the issue for a while. For now I fixed it like this:
Workbooks(sWB).Sheets("Output").Unprotect sPW
Workbooks(sWB).Sheets("Output").ChartObjects(1).Activate 'chart sometimes falls asleep somehow, maybe this will fix
Workbooks(sWB).Sheets("Output").ChartObjects(1).Chart.Export strDocName
This seems to have solved the issue which I dubbed "sleeping charts" for now.
However, I would like to understand how this works, and to fix it without using "Activate" as that can impact the user experience of my users (who use multiple Excel sheets along this VBA-excel form).
Anyone who understands what happens here?
Full function code chain
Private Sub C171CmdLe1Dr1Graph_Click()
Call ShowGraph(1, 1, True)
End Sub
Private Sub ShowGraph(ByVal intLeNr As Integer, ByVal intDrNr As Integer, ByVal Show As Boolean) 'Delete
Dim strDocName As String
Dim strLeNr As String
Dim oChart As Frm_DCT_ShowGraph
Call dle(intLeNr - 1).DrawChart(intLeNr, intDrNr)
'export the chart
strDocName = strMyDocsPath & "\DRT_Chart" & Right(strLeNr, 1) & ".gif"
Workbooks(sWB).Sheets("Output").Unprotect sPW
Workbooks(sWB).Sheets("Output").ChartObjects(1).Activate 'chart sometimes falls asleep somehow, maybe this will fix
Workbooks(sWB).Sheets("Output").ChartObjects(1).Chart.Export strDocName
If Show Then
'create new chart, load it and show it
Set oChart = New Frm_DCT_ShowGraph
oChart.DocName = strDocName
oChart.Show vbModeless
End If
Workbooks(sWB).Sheets("Output").Protect sPW
DoEvents
End Sub
Public Sub DrawChart(ByVal intLeNr As Integer, ByVal intDrNr As Integer)
Dim lngN As Long
Dim sngPlotArr() As Single
Dim strIRange As String
Dim strURange As String
...
'create plot data
Call cDriver(intDrNr - 1).Plot(sngPlotArr)
'unlock worksheet
Workbooks(sWB).Sheets("Output").Unprotect sPW
'clear range first
Workbooks(sWB).Sheets("Output").Range(strIRange).Clear
Workbooks(sWB).Sheets("Output").Range(strURange).Clear
'fill in data
For lngN = 0 To UBound(sngPlotArr, 1)
Workbooks(sWB).Sheets("Output").Range(strIRange).Columns(lngN + 1).Value2 = sngPlotArr(lngN, 0)
Workbooks(sWB).Sheets("Output").Range(strURange).Columns(lngN + 1).Value2 = sngPlotArr(lngN, 1)
'give OS some time
If lngN Mod 100 = 0 Then
DoEvents
End If
Next
...
'relock
Workbooks(sWB).Sheets("Output").Protect sPW
End Sub
I need to change the status and write comments for about 100 lists in SharePoint every week. I tried to automate it. I know how to open them in edit mode with a macro, but I don't know how to change status or how to write a comment with a macro, any ideas?
Here is my code:
Sub TT()
Dim ie(40) As Object, obj As Object
Dim cislo As String
For i = 0 To 40
If Cells(i + 2, 1).Value = "" Then
Exit Sub
End If
Set ie(i) = CreateObject("Internetexplorer.Application")
ie(i).Visible = True
ie(i).Navigate "http://adress of sharepoint list .com"
Do While ie(i).Busy
Loop
Next i
End Sub
These tutorials should give you what you need to know...excellent and well done, they show you how to do it via Listobjects and via SQL
https://www.youtube.com/watch?v=nM-gq3N6f2E
There is a series of 13 videos.
I have a user form with three comboboxes and one text box that I would like to populate with named ranges or public variables. I am working in Excel 2010 on Windows. Here is what I have:
First I run through some code that converts one worksheet into a new configuration. I then call the userform which will set up the variables necessary to update the worksheet further. I have done this on a Mac and it works, but I am transitioning this from the mac to a windows server. I thought this would be the easy part but it in not working for some reason.
Here is the code for the userform.
Public KorS As String
Public ActivityID As String
Public Stage As String
Public varsaveme As String
Private Sub ufStageDt_Initialize()
AD = varsaveme & ".xls"
duh = KorS
Set Me.tbAdName.Text = duh
Set UserForm1.Caption = AD
'Set Me.cmbLowDt.List = "AnnDt"
Set Me.cmbHighDt.List = "AnnDt"
Set Me.cmbStage.List = "Stage"
Me.cmbLowDt.List = "AnnDt"
End Sub
The public variables are present in the code on the worksheet.
Here is the code that I used on the Mac.
Private Sub UserForm_Initialize()
Ad = varsaveme & ".xls"
duh = KorS
tbAdName.Text = varsaveme
UserForm.Caption = Ad
cmbLowDt.List = Range("AnnDt").Value
cmbHighDt.List = Range("AnnDt").Value
cmbStage.List = Range("Stage").Text
End Sub
Any assistance would be greatly appreciated. I am using the ufStageDt.Show command in the vba script to bring up the userform.
Set won't work, so eliminate that. Also, List expects an array. For a single hard-coded item, use Additem.
Me.cmbHighDt.Additem "AnnDt"
EDIT: "AnnDt" is a named range:
Me.cmbHighDt.List = Application.Transpose(ActiveSheet.Range("AnnDt"))
EDIT2: For dates:
Private Sub UserForm_Initialize()
Dim i As Long
With Me.cmbHighDt
.List = Application.Transpose(ActiveSheet.Range("AnnDt"))
For i = 0 To .ListCount - 1
.List(i) = Format(.List(i), "yyyy-mm-dd")
Next i
'to get it back to a date
ActiveSheet.Range("B1") = DateValue(.List(0))
End With
End Sub