This post is to help me answering here:
http://www.excelfox.com/forum/showth...2177#post12177
Download both uploaded files
( Save them in the same place )
Open file
“OpenAndRunMemacros.xls”
Run macro Sub MeMacroClitbored()
That should cause the file LibroSoci.xls to be opened. It looks like this
_____ Workbook: LibroSoci.xls ( Using Excel 2007 32 bit )
Worksheet: LibroSoci
Row\Col A B C D 1 2 3Ciao 4
That should do _ some things with the variable NTes
_ The variables contents appear in a message box
LibroSociMsgBox.JPG : https://imgur.com/pEnKG7u
LibroSociMsgBox.JPG
¬
_ The code lines,
rowNo = xlBook.Worksheets("LibroSoci").Range("C:C").Find(What:=NTes, LookIn:=xlValues).Row
xlBook.Worksheets("LibroSoci").Cells(rowNo, 4) = Year(Date) ,
are used.
So LibroSoci.xls changes to this:
UseCodeLine.JPG : https://imgur.com/11g5OHX
UseCodeLine.jpg
_____ Workbook: LibroSoci.xls ( Using Excel 2007 32 bit )
Worksheet: LibroSoci
Row\Col A B C D E 1 2 3Ciao 2020 4
Coding in
"LibroSoci.xls"
ThisWorkbookCodeModuleLibroSoci.jpg: https://imgur.com/WYo3jrJ
ThisWorkbookCodeModuleLibroSoci.jpg
Code:Option Explicit Private Sub Workbook_Open() 'Stop Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") Dim NTes As String objDataObject.GetFromClipboard: Let NTes = objDataObject.GetText() MsgBox prompt:=NTes Dim xlBook As Workbook 'Dim xlSheet As Excel.Worksheet 'Dim xldata As Excel.Range 'Dim ExcelPath As String Dim rowNo As Long ' ExcelPath = ThisWorkbook.Path & "\" ' CurrentProject.Path & "\" ' Set xlapp = CreateObject("Excel.Application") ' Set xlBook = xlapp.Workbooks.Open(ExcelPath & "LibroSoci.xls") Set xlBook = ThisWorkbook ' Set xlSheet = xlBook.Worksheets("LibroSoci") ' xlSheet.Select ' xlSheet.Activate ' With ActiveSheet Let rowNo = xlBook.Worksheets("LibroSoci").Range("C:C").Find(What:=NTes, LookIn:=xlValues).Row Let xlBook.Worksheets("LibroSoci").Cells(rowNo, 4).Value = Year(Date) ' If Me.Nuova_TessElett <> "" Then ' xlBook.Worksheets("LibroSoci").Cells(rowNo, 37) = Me.Nuova_TessElett ' End If ' End With End Sub
Coding in
"OpenAndRunMeMacros.xls"
Code:Option Explicit Sub MeMacroClitbored() Dim NTes As String: Let NTes = "Ciao" Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") objDataObject.SetText NTes objDataObject.PutInClipboard Application.OnTime EarliestTime:=Now(), Procedure:="AggiornaLibroSoci" End Sub Sub AggiornaLibroSoci() Dim xlapp As Excel.Application Dim xlBook As Excel.Workbook 'Dim xlSheet As Excel.Worksheet 'Dim xldata As Excel.Range Dim ExcelPath As String 'Dim rowNo As Long Let ExcelPath = ThisWorkbook.Path & "\" ' CurrentProject.Path & "\" Set xlapp = CreateObject("Excel.Application") Let xlapp.Visible = True Set xlBook = xlapp.Workbooks.Open(ExcelPath & "LibroSoci.xls") ' Set xlSheet = xlBook.Worksheets("LibroSoci") ' xlSheet.Select ' xlSheet.Activate ' ' With ActiveSheet ' rowNo = xlBook.Worksheets("LibroSoci").Range("C:C").Find(What:=NTes, LookIn:=xlValues).Row ' xlBook.Worksheets("LibroSoci").Cells(rowNo, 4) = Year(Date) ' ' If Me.Nuova_TessElett <> "" Then ' ' xlBook.Worksheets("LibroSoci").Cells(rowNo, 37) = Me.Nuova_TessElett ' ' End If ' ' End With ' xlBook.Save xlBook.Close xlapp.Quit ' Set xlSheet = Nothing Set xlBook = Nothing Set xlapp = Nothing End Sub




Reply With Quote
Bookmarks