I'm attempting to use VBA to take in some coordinates from a SQL table, create some code that sits in an excel tab that is then saved as a .kml file and open the file in Google Earth.
When the code creates the kml file it then opens GE but nothing happens (as in, it doesn't show the coordinates in the sidebar and doesn't point to anything).
Similarly, when I navigate to the kml file manually and open it in GE, nothing happens.
However, if I go back to the excel tab that is being saved as .kml, copy/paste the code into notepad and manually save as .kml, the file opens in GE and displays the coordinates from the code.
I have stripped the code back to the minimum required to highlight my problem (see below).
From what I've observed it would seem I'm not saving the file properly.
Sub Mapping()
Range("A1").Value = "<?xml version=""1.0"" encoding=""UTF-8""?>"
Range("A2").Value = "<kml xmlns=""http://www.opengis.net/kml/2.2"""
Range("A3").Value = "xmlns:gx=""http://www.google.com/kml/ext/2.2"" "
Range("A4").Value = "xmlns:kml=""http://www.opengis.net/kml/2.2"" "
Range("A5").Value = "xmlns:atom=""http://www.w3.org/2005/Atom"">"
Range("A6").Value = "<Document>"
Range("A7").Value = " <Placemark> <name>" & "Name here..." & "</name> <description>" & "Testing" & "</description>"
Range("A8").Value = "<Style> <IconStyle> <scale>1.2</scale> <Icon> <href>http://maps.google.com/mapfiles/kml/pal4/icon16.png</href> </Icon> </IconStyle> </Style> "
Range("A9").Value = "<Point> <coordinates>" & " -114.232195463845,53.0160219116952,0" & "</coordinates> </Point> </Placemark>"
Range("A10").Value = "</Document> </kml> "
ActiveSheet.SaveAs "C:\Users\user\Desktop\KMLTESTING4.kml"
Dim KMLLoc As String
KMLLoc = "C:\Users\user\Desktop\KMLTESTING4.kml"
Call Shell("explorer.exe " & KMLLoc, vbNormalFocus)
End Sub
Added FileFormat:=xlTextPrinter to the end of my save and now working fine.
Related
I have a big table in ms-word that contains 85 contentcontrols (combo boxes). I want to change the content using a vba loop (see below). It takes longer than one minute for it to complete...
Are there other options?
Private Sub Btn_Clear1_Click()
Dim a
Dim c As ContentControl
a = FindTable(ActiveDocument.Name, "myTableName")(1) 'returns an array(Long) with number of table found
For Each c In ActiveDocument.Tables(a).Range.ContentControls
c.Range.text = "MY CHANGED TEXT"
Next c
End Sub
Thanks in advance for any hint!
Here, turning off screenupdating reduces the time from about 6 seconds to less than 1 second. e.g.
On Error Goto turnscreenon
Application.Screenupdating = False
For Each c In ActiveDocument.Tables(a).Range.ContentControls
c.Range.text = "MY CHANGED TEXT"
Next c
turnscreenon:
Application.Screenupdating = True
That may only work on the Windows version of Word.
If you know exactly how many combo boxes there are going to be, you could consider creating a custom xml part containing an array of XML Elements to contain the values. Map each content control to one of those elements. Then instead of writing the values to the content control ranges, write them to the XML Part and let Word do the work. That works almost instantaneously here.
e.g. in a simple scenario where you just have those 85 content controls in the table, you could set up the Custom XML Part like this (I leave you to write any code that you need to delete old versions). You should only need to run this once.
Sub createCxpAndLink()
' You should choose your own Uri
Const myNamespaceUri As String = "mycbcs"
Dim a
Dim i As Long
Dim s As String
Dim cxp As Office.CustomXMLPart
With ActiveDocument
a = FindTable(.Name, "myTableName")(1)
s = ""
s = s & "<?xml version='1.0' encoding='UTF-8'?>" & vbCrLf
s = s & "<cbcs xmlns='" & myNamespaceUri & "'>" & vbCrLf
For i = 1 To .Tables(a).Range.ContentControls.Count
s = s & " <cbc/>" & vbCrLf
Next
s = s & "</cbcs>"
Set cxp = .CustomXMLParts.Add(s)
With .Tables(a).Range.ContentControls
For i = 1 To .Count
.Item(i).XMLMapping.SetMapping "/x:cbcs[1]/x:cbc[" & Trim(CStr(i)) & "]", "xmlns:x='" & myNamespaceUri & "'", cxp
Next
End With
Set cxp = Nothing
End With
End Sub
Then to update the contents you need something like this
Sub testsetxml()
Const myNamespaceUri As String = "mycbcs"
Dim i As Long
'our start time...
Debug.Print Now
With ActiveDocument.CustomXMLParts.SelectByNamespace(myNamespaceUri)(1)
For i = 1 To 85
.SelectNodes("/ns0:cbcs[1]/ns0:cbc[" & Trim(CStr(i)) & "]")(1).Text = "my changed text "
' or if you want to put different texts in different controls, you can test using e.g.
.SelectNodes("/ns0:cbcs[1]/ns0:cbc[" & Trim(CStr(i)) & "]")(1).Text = "my changed text " & Cstr(i)
Next
End With
'our end time...
Debug.Print Now
End Sub
(NB you cannot do it by mapping all the controls to a single XML element because then all the dropdowns will all be updated to the same value whenever you change the value of one of them.)
Apologies for any typos - I've changed the code to be more in line with what you have already and have not tested the changes.
I'm trying to output reports. They all follow the same information, just for different managers. I can't seem to get any of the right syntax in to modify the necessary parts (Recordsource, Caption, and 1 field that will contain a set string). I don't know what its asking me and I can get the code to find the next manager name (a recordsource) and cycle through them. I can get the code to output to PDF file no problem. It's the relevant code below that I need to figure out. It's probably completely wrong. I haven't really dealt with reports yet.
DoCmd.OpenReport "rptUsageReportTemplate", acViewReport
Reports("rptUsageReportTemplate").RecordSource = MngrUsgRptStr
Reports("rptUsageReportTemplate").Caption = MngrName & "'s " & Mnth & " Usage Report"
Reports("rptUsageReportTemplate").Controls("fldManagerHeader") = MngrName & "'s " & Mnth & " Usage Report"
Reports("rptUsageReportTemplate").Requery
DoCmd.Close acReport, "rptUsageReportTemplate", acSaveYes
The "docmd.openreport" Is in there because i couldn't stop getting the error 2451 - The report name [...] you entered is misspelled or refers to a report that isn't open or doesn't exist." I know it exists and I know it's spelled correctly. So it must be an open thing. If I can get Access to output reports behind the scenes without needing to see the report open and close, that would be great.
In short what I want is for the Report I saved to be a template and just update the values a bunch of times and save it to file.
Assuming that you have a "Managers" Table or similar (tblManagersOrSuch) the following untested sub should get you going...
Sub DoManagersReport(Mnth As Integer)
Dim rsManagers As DAO.Recordset
Set rsManagers = CurrentDb.OpenRecordset("tblManagersOrSuch")
If Not rsManagers.EOF Then
rsManagers.MoveFirst
Do Until rsManagers.EOF
DoCmd.OpenReport "rptUsageReportTemplate", acViewPreview, , , acHidden
Reports("rptUsageReportTemplate").Caption = rsManagers!ManagerID & "'s " & Mnth & " Usage Report"
Reports("rptUsageReportTemplate").Controls("fldManagerHeader") = rsManagers!ManagerID & "'s " & Mnth & " Usage Report"
Reports("rptUsageReportTemplate").RecordSource = "Select * from MngrUsgRptStr Where ManagerID = " & rsManagers!ManagerID
DoEvents
Reports("rptUsageReportTemplate").Visible = True
DoCmd.OutputTo acOutputReport, "rptUsageReportTemplate", acFormatPDF, "C:\" & rsManagers!ManagerID & " " & Mnth & " Usage Report.pdf"
DoEvents
DoCmd.Close acReport, "rptUsageReportTemplate"
Loop
End If
'add error handling
End Sub
Note that setting the RecordSource forces a requery so you do not require that.
I would also suggest adding a fileSaveAs function to determine the save folder...
I need to put a link to another Excel files in my current Workbook.
This is the part of my VBA code that does that:
v_fileNameToImport = ThisWorkbook.Path & "\" & v_techs(i) & "\" & v_regions(j) & "\Results\" & v_files(k)
v_sheetName = "RESUMO " & v_regions(j)
'Check if there is already a tab for this region
If (SheetExists(v_sheetName)) Then
Worksheets(v_sheetName).OLEObjects.Add Filename:=v_fileNameToImport, Link:=True, DisplayAsIcon:=True, Top:=40, Left:=160, Width:=100, Height:=100
Else
Set v_sheet = ThisWorkbook.Sheets.Add
v_sheet.Name = v_sheetName
v_sheet.OLEObjects.Add Filename:=v_fileNameToImport, Link:=True, DisplayAsIcon:=True, Top:=40, Left:=40, Width:=100, Height:=100
End If
After running the macro, each file link appears as a blank rectangle instead of an Excel icon. When I click it, it starts to open the other file but crashes right away.
Edit: It seems that when I run the macro for the second time, i.e. after already importing the files, it will crash, despites all tabs are deleted when the macro starts. Maybe the reference to the files remains despites its tabs are deleted, what causes a conflict with a new reference to the same file. When running from a fresh file this problem does not happens.
I have a template document in Word 2013 that has the user fill in a large number of Legacy Text FormFields. At the end of the document, I've included a button which compiles the answers into a string devoid of formatting, then copies it to the clipboard.
It works, but as each FormField is read, the Word document skips back and forth between each text field and the end of the document. It's visually alarming. Is there a way to gather the values of each FormField without Word moving the cursor/focus to each field as it is read?
Here's a sample of the code:
Private Sub cmdCreateNote_Click()
Call cmdClearNote_Click
Dim ff As FormFields
Set ff = ActiveDocument.FormFields
Dim Output As String
Output = ff("ddReviewType").Result & vbCrLf
If ff("chFacInfo").Result Then
Dim FacInfo
FacInfo = Array("Field1: ", _
"Field2: ", _
"Field3: ", _
"Field4: ", _
"Field5: ")
Output = Output & "FIRST SECTION" & vbCrLf
For Index = 1 To 5
If ff("chFacInfo" & Index).Result Then
Output = Output & FacInfo(Index - 1) & ff("txFacInfo" & Index).Result & vbCrLf
End If
Next
Output = Output & vbCrLf
End If
Dim FORange As Range
Set FORange = ActiveDocument.Bookmarks("FinalOutput").Range
FORange.Text = Output
ActiveDocument.Bookmarks.Add "FinalOutput", FORange
Selection.GoTo What:=wdGoToBookmark, Name:="FinalOutput"
Selection.Copy
End Sub
It appears that every time I access ActiveDocument.FormFields( x ).Result, the document focus goes to that element, then drops back to the end of the document again.
Any pointers?
Use the Bookmark object instead of the FormField. This will allow you to access the properties without changing the screen focus. See answer on Suppress unwanted jumping/scrolling on Word 2013 VBA Script for specifics on how to do this.
ActiveDocument.Bookmarks("myFieldName").Range.Fields(1).Result
Posting comment as answer, since it worked!
Try Application.ScreenUpdating = False before going through the FormFields and then setting it to True after, in order to minimize screen updating.
I would like to create a VB "Save As" macro for Excel that would utilize the data from cell B7,B5 and =NOW as the file name. This new file name would then be saved to a particular directory. (Ex. User clicks "Save" button. File name = (B5)ABCD_(B7)EFGH_=NOW is created and then saved to a directory of my choosing.
I have found scripts that offer some of the singular options, but have had no luck finding or creating a script of my own with these options. Any help would be greatly appreciated.
You need to substitute for the invalid characters in the filename (they can't contain / or :) with periods or something else.
Sub DateFile()
Dim str As String
str = Range("B5").Value & "ABCD_" & Range("B7").Value & "EFGH" & Now()
str = Replace(str, "/", ".")
str = Replace(str, ":", ".")
ActiveWorkbook.SaveAs (str)
End Sub
This can then be integrated into your push button code.