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.
Related
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
Private Sub OK_Click(sender As System.Object, e As System.EventArgs) Handles OK.Click
If TextBox1.Text = "1234" Then
' This is the connection. You have to have this exact string, except "E:\Documents\notekeeper.mdb" will be the path to your thing instead
Dim conn As New OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=N:\Visual Studio 2010\Projects\Maths System Aid\Maths System Aid\Database7.mdb;User=;Password=;")
Try
conn.Open()
Catch ex As Exception
MsgBox("Cannot open database")
End Try
' The SQL statement / command
Dim cmd = New OleDbCommand("Insert INTO Student ([First Name], [Surname], [Username], [Password]) VALUES "("" & TextBox5.Text & "," & TextBox4.Text & "," & TextBox3.Text & "," & TextBox2.Text & "" & ")"), conn)
cmd.ExecuteNonQuery() ' Use ExecuteReader() to execute SELECT statements, but ExecuteNonQuery() for others
' Basically, the reader is like an array of all of the records that have been returned by the database
Me.Close()
StudentLogin.Show()
Else
MsgBox("Enter The Correct Confirmation code")
End If
End Sub
my problem is that it will not find my database file. I have followed the path and it is correct. Any ideas of what is the problem?
I haven't done this in quite some time but at the top of your form you should be running some imports firstly
imports system.data
Then you should define rather like this:
dim conn as new oledb.oledbconnection
Another issue I noticed in your code is that you're using the Jet provider which if memory serves correctly only works with the new databases using the .accdb extension. Try to change it to an accdb in access.. I'll go over it quick and see what I can conjure up. Hopefully that helps at least. The alternative provider if you run into issues :
("Provider=Microsoft.ACE.OLEDB.12.0.......
Is this path a local disk or a network disk? is it on another computer or a mapped network drive?
The way I connect is
Dim con As New OleDb.OleDbConnection
Dim dbProvider As String
Dim dbSource As String
dbProvider = "PROVIDER=Microsoft.Jet.OLEDB.4.0;"
dbSource = "Data Source = C:\data\database.mdb;Jet OLEDB:Database Password=******;"
con.ConnectionString = dbProvider & dbSource
con.open()
con.close()
This should work perfect but use your path and password if you have one
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
I am working with Delphi(2010), but I'm new with PowerPoint(2010)
I've found two codes for copying slides with "keep source formatting":
Sub test1()
Dim orig_slide, new_slide As Slide
Dim slide_range As SlideRange
Set orig_slide = ActivePresentation.Slides(2)
orig_slide.Copy
Set slide_range = ActivePresentation.Slides.Paste(6)
Set new_slide = slide_range.Item(1)
new_slide.Design = orig_slide.Design
new_slide.ColorScheme = orig_slide.ColorScheme
End Sub
Sub test2()
ActivePresentation.Slides(2).Select
ActiveWindow.Selection.Copy
ActiveWindow.View.PasteSpecial (DataType = ppPasteOLEObject)
End Sub
They both are giving desired results in PowerPoint but in Delphi i get exceptions :
test1, line
new_slide.Design = orig_slide.Design
exception class EOleSysError with message 'Member not found'
test2, line
ActiveWindow.View.PasteSpecial (DataType = ppPasteOLEObject)
exception class EOleException with message 'View.PasteSpecial : Invalid request. The specified data type is unavailable'
I am using Slide Sorter View, copying and pasting are working ok, I'm only trying to add "keep source formatting" command.
Thanks in advance
I think I've found a solution :
This code in Delphi (doesn't work)
var OrigSlide, NewSlide : Variant;
NewSlide.Design := OrigSlide.Design;
on the right side, Delphi seems to accept only variant_variable, it doesn't accept variant_variable.property
Left side seems to work in opposite way ?!?
When I replaced it with this code, it works
OrigSlide := OrigSlide.Design;
NewSlide.Design := OrigSlide;
But I can only guess why.
I'd like to extend the MS Excel 2010 by adding some more "Additional Cell Actions". (accessible via cell right-click > Additional Cell Actions). Specifically, I'd like Excel to:
recognize five-to-eight digit numbers as Part Numbers with action: "Open URL to technical docs"
recognize string "OR ## #####" (# for digit) as Order Reference with actions: "Open spec file" and "Open material file" (both Excel files located at specified paths in the intranet)
Now, I have no idea how to program this. I suspect that some XML snippet is needed and probably some VB code too. VB code wouldn't be a problem - I have macros doing those functionalities done for Excel 2003 - but I have no idea where to place it.
Please give me some pointers, I've asked Google but can't get the answer, seems that "Additional Actions" is pretty common phrase :)
This can be achieved by adding a right click event handler to the workbook
In the Workbook module add this code
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim cBut As CommandBarButton
Dim v As Variant
On Error Resume Next
v = Target
' Remove any previously added menu items
Application.CommandBars("Cell").Controls("Open URL to technical docs").Delete
Application.CommandBars("Cell").Controls("Open material file").Delete
' save cell value for use by called macro
CellValue = v
' If cell matches criteria add menu item and set macro to call on click
If IsNumeric(v) Then
If v >= 10000 And v <= 99999999 Then
Set cBut = Application.CommandBars("Cell").Controls.Add(Temporary:=True)
With cBut
.Caption = "Open URL to technical docs"
.Style = msoButtonCaption
.OnAction = "OpenRef"
End With
End If
ElseIf v Like "OR ## #####" Then
Set cBut = Application.CommandBars("Cell").Controls.Add(Temporary:=True)
With cBut
.Caption = "Open material file"
.Style = msoButtonCaption
.OnAction = "OpenMat"
End With
End If
End Sub
In a standard module add this code
Public CellValue As Variant
' replace MsgBox code with your logic to open files
Sub OpenRef()
MsgBox "Open Reference Doc code here for " & CellValue
End Sub
Sub OpenMat()
MsgBox "Open Material File code here for " & CellValue
End Sub