Created this very simple code - however guess not too elegant, maybe there are much more logical solutions but me is not a vba expert - which has to copy only visible data ranges from source to data workbook after filtering.
Code is working but the part where has to copy/paste there is a message with run time error 1004 / which shows that copy and paste area are not the same...doesnt understand as made originally a test and worked but with the final files do not...sucking on this for days and cannot solve:/
Further all these details has to be paste without header which I cannot handle however read over many on your page with similar request but cannot find a real solution or doesnt understand:/
Tried with offset but cannot work if simply put it into the rows like this
Cells.SpecialCells(xlCellTypeVisible).offset(1.0)
Many thx in advance for your valuable help
Sub CALL_REPORT()
Dim wbLCLHU As Workbook: Set wbLCLHU = Workbooks("SOURCE.xlsm")
Dim wsLCLHU As Worksheet: Set wsLCLHU = wbLCLHU.Sheets("ENTRY")
Dim rngLCLHU As Range: Set rngLCLHU = wsLCLHU.Range("A:CE")
Dim wbCallLCL As Workbook: Set wbCallLCL = Workbooks("COLLECT.xlsx")
Dim wsCallLCL As Worksheet: Set wsCallLCL = wbCallLCL.Sheets("LCL")
Dim rngCallLCL As Range: Set rngCallLCL = wsCallLCL.Range("A:V")
Dim lastrowCall As Long
lastrowCall = rngCallLCL(rngCallLCL.Rows.Count, "H").End(xlUp).Row + 1
'Remove filter that was applied.
Workbooks("SOURCE").Sheets("ENTRY").AutoFilterMode = False
With rngLCLHU
.autofilter Field:=37, Criteria1:=(BLanks)
.autofilter Field:=83, Criteria1:=(BLanks)
End With
Dim rngLCLHUSPOT As Range
Set rngLCLHUSPOT = Range("H:H").Cells.SpecialCells(xlCellTypeVisible)
rngLCLHUSPOT.copy
wsCallLCL.Range("I" & lastrowCall).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Dim rngLCLHUSHIPPER As Range
Set rngLCLHUSHIPPER = Range("M:M").Cells.SpecialCells(xlCellTypeVisible)
rngLCLHUSHIPPER.copy
wsCallLCL.Range("E" & lastrowCall).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'followed by many times copy paste with different ranges, method same of each as above
'and above printed full method repeat as much as many source I have
End
Related
I wrote a code to break links to the source excel file for my powerpoint deck, the macro works well except for 2 charts. Both the charts are on the same slide (which is not uncommon) and are line charts. The charts need to be manually updated but the data resides in a excel file only. Not sure what am I missing. This is the code that I wrote
Sub SavePPT()
Dim objPP As Object
Dim objPPFile As Object
Dim sld As Object
Dim shp As Object
Dim shp1 As Chart
Dim newshp As Shape
Dim pptChart As Object
Set objPP = CreateObject("PowerPoint.Application")
objPP.Visible = True
Set objPPFile = objPP.ActivePresentation
objPPFile.Save
Application.EnableEvents = False
For Each sld In objPPFile.Slides
For Each shp In sld.Shapes
If shp.HasChart Then
shp.LinkFormat.BreakLink
On Error GoTo 0
End If
Next
Next
Application.EnableEvents = False
For Each sld In objPPFile.Slides
For Each shp In sld.Shapes
If shp.Type = msoLinkedOLEObject Or shp.Type = msoEmbeddedOLEObject Then
shp.LinkFormat.BreakLink
On Error GoTo 0
End If
Next
Next
objPPFile.SaveAs ("Location" _ & Format(Now(), "MM-DD-YYYY") & ".pptx")
objPPFile.Close
objPP.Quit
Set pptChart = Nothing
Set objPPFile = Nothing
Set objPP = Nothing
End Sub
The chart might be in a placeholder, in which case none of your code will act upon it. If the shape's .Type = msoPlaceholder (ie, 14), check the shape's .PlaceholderFormat.ContainedType property to see if it's a linkedOleobject or .HasChart etc.
BTW, an msoEmbeddedOLEObject won't have a .LinkFormat object to call on; I suspect you have some error handling code that's obscuring an error there. In any case, I'd limit that check to just msoLinkedOLEObject.
Thanks for you help. I realized it later that those 2 slides have a lot of text boxes on them and when I consolidate some of those textboxes the issue was resolved.
I had some excel VBA code, and it doesn't work in Open Office Calc.
Code in excel copy files from list from different catalog to another.
I don't know macro programming in open office. I read about diffrent declaration, but it really hard for me. What should I change for open office?
I will really grateful for any help.
Sub copyfiles()
Dim xRg As Range, xCell As Range
Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
Dim xSPathStr As Variant, xDPathStr As Variant
Dim xVal As String
On Error Resume Next
Set xRg = Application.InputBox("Wybierz pliki do skopiowania:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
If xRg Is Nothing Then Exit Sub
Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
xSFileDlg.Title = "Wybierz folder z którego kopiuję:"
If xSFileDlg.Show <> -1 Then Exit Sub
xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
xDFileDlg.Title = "Wybierz folder do którego kopiuję:"
If xDFileDlg.Show <> -1 Then Exit Sub
xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
For Each xCell In xRg
xVal = xCell.Value
If TypeName(xVal) = "String" And xVal <> "" Then
FileCopy xSPathStr & xVal, xDPathStr & xVal
End If
Next
End Sub
The code needs to be entirely rewritten. OpenOffice Basic is a completely different programming platform from MS Office VBA.
One good place to start learning OpenOffice Basic is http://www.pitonyak.org/oo.php.
In Writer, I would like to search for some text and when found position the view to the top of the view/window.
Using the following code,
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(1) as new com.sun.star.beans.PropertyValue
args1(0).Name = "SearchItem.SearchString"
args1(0).Value = ":"
dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args1())
the view changes and it shows the selection but it is not in any particular place. I want it to be at the top of the window/view.
I've also found elsewhere the use of ThisComponent.currentController.getViewData() and restoreViewData(). So I experimented and determined how to change the data returned in order to get a vertical scroll but nothing happens. For example...
vd = ThisComponent.currentController.getViewData()
vdParts = Split(vd, ";")
vdParts(6) = CLng(vdParts(6)) + 1000
vd = join(vdParts, ";")
ThisComponent.currentController.restoreViewData(vd)
Any suggestions?
PS: I am running version 5.0.5.2 on Windows 7 x64
Spreadsheets have View Panes that can be manipulated, but it does not look like there is a similar interface in Writer.
Instead, use the View Cursor to go down one or two pages, then move back to the location of the search result.
Also, do not use the dispatcher for the search. Use the API instead, like in section 7.14 of Andrew Pitonyak's macro document.
After I did a query in openoffice-base over a customized form I want to transfer a selected set of data into a template openoffice-calc table. I know I can access the data set in openoffice-calc via pressing the Data Source (F4) button but then I only get access over the query. The best solution would be after the database query over a form a button event is required to open a openoffice-calc table from the template and insert the data from the data set.
First go to Tools -> Macros -> Organize Macros -> LibreOffice Basic and add this code. Change the path of the template file.
Sub Copy_Record_To_Calc(oEvent)
Dim oForm
Dim templatePath As String
Dim oServiceManager As Object, oDesktop As Object
Dim oFileProperties As Object
Dim oDoc As Object, oSheet As Object, oCell As Object
Dim column As Integer
oForm = oEvent.Source.getModel().getParent()
If oForm.isAfterLast() Then
Print "Hey, you are after the last element."
Exit Sub
ElseIf oForm.isBeforeFirst() Then
Print "Hey, you are before the first element."
Exit Sub
End If
templatePath = "file:///C:/Users/JimStandard/Desktop/Untitled 2.ots"
Set oServiceManager = CreateObject("com.sun.star.ServiceManager")
Set oDesktop = oServiceManager.createInstance("com.sun.star.frame.Desktop")
Set oFileProperties(0) = new com.sun.star.beans.PropertyValue
oFileProperties(0).Name = "AsTemplate"
oFileProperties(0).Value = True
Set oDoc = oDesktop.loadComponentFromURL( _
templatePath, "_blank", 0, Array(oFileProperties))
oSheet = oDoc.Sheets(0)
For column = 1 to 2
oCell = oSheet.getCellByPosition(column - 1, 0)
oCell.String = oForm.getString(column)
Next column
End Sub
Then in form design mode, right-click on the button and choose Control. In the Events tab, click the three dots next to Execute action. Click Macro... and find the Copy_Record_To_Calc macro that you added.
Now turn design mode off. Go to a record and click the button. It will open the Calc template and copy the first two columns of the current record into column A and B of the spreadsheet.
See also:
Section 4.2.1 of Andrew Pitonyak's Base Macros (PDF)
ResultSet documentation
This thread gives an example of using a Calc template.
I've seen this method over the internet: Create Short URLs Using APIs and Google Docs
How can I use this method using www.tinyurl.com?
Can you please help me? thank you!
No credentials are required to access the tinyurl api. It is dead simple, requiring only the long url in the query:
http://tinyurl.com/api-create.php?url=<longUrl>
A spreadsheet function similar to those in the referenced article would be:
= importData(concatenate("http://tinyurl.com/api-create.php?url=",B1))
Reference: Tinyurl has an API.
=importData is only for googlesheets.
Which answers this question.
But for those who use Excel you can use VBA code
Option Explicit
Public Sub tinyURL()
Dim qt As QueryTable
Dim ws As Worksheet
Dim Copy As Integer
Dim Paste As Integer
Dim i As Integer
Dim URL As String
i = 2
Copy = 2
Paste = 2
Set ws = ThisWorkbook.Worksheets("Sheet1")
'loops until column A is empty
Do Until IsEmpty(Cells(i, 1))
'Copy from list in Column A and paste result into column B
URL = "INSERT THE TINYURL API URL HERE ENDING WITH =" & Range("A" & Copy)
Set qt = ws.QueryTables.Add(Connection:="URL;" & URL, Destination:=ws.Range("B" & Paste))
With qt
.RefreshOnFileOpen = True
.FieldNames = True
.WebSelectionType = xlSpecifiedTables
.WebTables = 1
.Refresh BackgroundQuery:=False
End With
i = i + 1
Copy = Copy + 1
Paste = Paste + 1
Loop
End Sub