![]() |
several scripts in one single script
Hello. I have the following problem. I have 3 scripts that i have linked to 3 buttons. Instead of pressing 3 buttons i would like to be able to do the same thing by pressing only one button. Here are the scripts: Code: -------------------- SUB IMPORTLOCAL() Dim Fname As Variant Dim WB As Workbook Dim DestRng As Range ChDrive "c:\" '<<< CHANGE ChDir "c:\Documents and Settings\" '<<< CHANGE" Fname = Application.GetOpenFilename("Excel Files (*.xls), *.xls") If Fname = False Then Exit Sub ' user didn't select any file End If ' open the source workbook Set WB = Workbooks.Open(filename:=Fname) ' copy cell Sheet1!A1 from WB to ThisWorkbook WB.Worksheets("Consumuri mat.").Range("A5:M63").Copy _ Destination:=ThisWorkbook.Worksheets("Consumuri mat.").Range("A5:M63") 'verificat* WB.Worksheets("N.E cherestea").Range("A6:N100").Copy _ Destination:=ThisWorkbook.Worksheets("N.E cherestea").Range("A6:N100") 'verificat* WB.Worksheets("PAL").Range("A6:AR100").Copy _ Destination:=ThisWorkbook.Worksheets("PAL").Range( "A6:AR100") 'verificat* WB.Worksheets("PFL").Range("A5:AQ100").Copy _ Destination:=ThisWorkbook.Worksheets("PFL").Range( "A5:AQ100") 'verificat* WB.Worksheets("MDF").Range("A7:AP100").Copy _ Destination:=ThisWorkbook.Worksheets("MDF").Range( "A7:AP100") 'verificat* WB.Worksheets("Placaj").Range("A6:AL100").Copy _ Destination:=ThisWorkbook.Worksheets("Placaj").Ran ge("A6:AL100") 'verificat* WB.Worksheets("Furnire").Range("A6:BD100").Copy _ Destination:=ThisWorkbook.Worksheets("Furnire").Ra nge("A6:BD100") 'verificat* WB.Worksheets("Finisaj").Range("F7:K109").Copy _ Destination:=ThisWorkbook.Worksheets("Finisaj").Ra nge("F7:K109") 'verificat WB.Worksheets("Ogl+Geam 2").Range("B3:I33").Copy _ Destination:=ThisWorkbook.Worksheets("Ogl+Geam 2").Range("B3:I33") 'verificat WB.Worksheets("Ogl + Geam 1").Range("B3:I33").Copy _ Destination:=ThisWorkbook.Worksheets("Ogl + Geam 1").Range("B3:I33") 'verificat WB.Worksheets("Somiera").Range("A1:F15").Copy _ Destination:=ThisWorkbook.Worksheets("Somiera").Ra nge("A1:F15") 'verificat WB.Worksheets("PAL ROWENI").Range("A6:AR100").Copy _ Destination:=ThisWorkbook.Worksheets("PAL ROWENI").Range("A6:AR100") 'verificat* WB.Worksheets("MDF ROWENI").Range("A7:AP100").Copy _ Destination:=ThisWorkbook.Worksheets("MDF ROWENI").Range("A7:AP100") 'verificat* WB.Worksheets("Furnire ROWENI").Range("A6:BD100").Copy _ Destination:=ThisWorkbook.Worksheets("Furnire ROWENI").Range("A6:BD100") 'verificat* ' close the sourse workbook WB.Close SaveChanges:=False End Sub -------------------- Code: -------------------- SUB SALVARE() 'Retrieve file name to use for Save fileSaveName = Application.GetSaveAsFilename( _ FileFilter:="Excel Files (*.xls), *.xls") 'If user specified file name, perform Save and display msgbox If fileSaveName < False Then ActiveWorkbook.SaveAs filename:=fileSaveName, FileFormat:=xlNormal MsgBox "Fisier salvat in:" & fileSaveName End If End Sub -------------------- Code: -------------------- SUB EXPORT_RAND_DIN_FISA() Dim file As String Dim SupplyFile As Workbook Dim TrgtFile As Variant Dim Sht1 As String Dim Rw As Integer ChDrive "c:\" '<<< CHANGE ChDir "C:\Documents and Settings\Vasnic\Desktop\" '<<< CHANGE file = ActiveWorkbook.Name ' to save workbook name Sht1 = ActiveSheet.Name ' to save the sheet name TrgtFile = Application.GetOpenFilename("Excel Files (*.xls), *.xls") If TrgtFile = False Then Exit Sub End If Set SupplyFile = Workbooks.Open(filename:=TrgtFile) Rw = Application.InputBox("Selectati randul unde se vor exporta datele", Type:=8).Row ' To Bring the required row With ActiveSheet .Range("B" & Rw) = Workbooks(file).Sheets(Sht1).Range("D7") .Range("C" & Rw) = Workbooks(file).Sheets(Sht1).Range("D10") .Range("G" & Rw) = Workbooks(file).Sheets(Sht1).Range("D12") .Range("H" & Rw) = Workbooks(file).Sheets(Sht1).Range("D15") .Range("K" & Rw) = Workbooks(file).Sheets(Sht1).Range("D98") .Range("O" & Rw) = Workbooks(file).Sheets(Sht1).Range("D119") .Range("U" & Rw) = Workbooks(file).Sheets(Sht1).Range("J51") .Range("Z" & Rw) = Workbooks(file).Sheets(Sht1).Range("D121") End With End Sub -------------------- Ok. That's about it. So i would like the script to work in the following fashion: Subimportlocal - MessageBox (Is everything ok?? YES/NO). If YES then Sub Salvare and then Sub Export_rand_din_fisa - End. If No - End. I tried myself sevaral things but didn't work. So any help would be apreciated. Thank you! -- adinic ------------------------------------------------------------------------ adinic's Profile: http://www.excelforum.com/member.php...o&userid=31529 View this thread: http://www.excelforum.com/showthread...hreadid=558359 |
several scripts in one single script
Why not create a new macro
Sub SingleMacro() IMPORTLOCAL SALVARE EXPORT_RAND_DIN_FISA End Sub and attach the single button to this macro. Simple, minimal, and should work. -- HTH Bob Phillips (replace somewhere in email address with gmail if mailing direct) "adinic" wrote in message ... Hello. I have the following problem. I have 3 scripts that i have linked to 3 buttons. Instead of pressing 3 buttons i would like to be able to do the same thing by pressing only one button. Here are the scripts: Code: -------------------- SUB IMPORTLOCAL() Dim Fname As Variant Dim WB As Workbook Dim DestRng As Range ChDrive "c:\" '<<< CHANGE ChDir "c:\Documents and Settings\" '<<< CHANGE" Fname = Application.GetOpenFilename("Excel Files (*.xls), *.xls") If Fname = False Then Exit Sub ' user didn't select any file End If ' open the source workbook Set WB = Workbooks.Open(filename:=Fname) ' copy cell Sheet1!A1 from WB to ThisWorkbook WB.Worksheets("Consumuri mat.").Range("A5:M63").Copy _ Destination:=ThisWorkbook.Worksheets("Consumuri mat.").Range("A5:M63") 'verificat* WB.Worksheets("N.E cherestea").Range("A6:N100").Copy _ Destination:=ThisWorkbook.Worksheets("N.E cherestea").Range("A6:N100") 'verificat* WB.Worksheets("PAL").Range("A6:AR100").Copy _ Destination:=ThisWorkbook.Worksheets("PAL").Range( "A6:AR100") 'verificat* WB.Worksheets("PFL").Range("A5:AQ100").Copy _ Destination:=ThisWorkbook.Worksheets("PFL").Range( "A5:AQ100") 'verificat* WB.Worksheets("MDF").Range("A7:AP100").Copy _ Destination:=ThisWorkbook.Worksheets("MDF").Range( "A7:AP100") 'verificat* WB.Worksheets("Placaj").Range("A6:AL100").Copy _ Destination:=ThisWorkbook.Worksheets("Placaj").Ran ge("A6:AL100") 'verificat* WB.Worksheets("Furnire").Range("A6:BD100").Copy _ Destination:=ThisWorkbook.Worksheets("Furnire").Ra nge("A6:BD100") 'verificat* WB.Worksheets("Finisaj").Range("F7:K109").Copy _ Destination:=ThisWorkbook.Worksheets("Finisaj").Ra nge("F7:K109") 'verificat WB.Worksheets("Ogl+Geam 2").Range("B3:I33").Copy _ Destination:=ThisWorkbook.Worksheets("Ogl+Geam 2").Range("B3:I33") 'verificat WB.Worksheets("Ogl + Geam 1").Range("B3:I33").Copy _ Destination:=ThisWorkbook.Worksheets("Ogl + Geam 1").Range("B3:I33") 'verificat WB.Worksheets("Somiera").Range("A1:F15").Copy _ Destination:=ThisWorkbook.Worksheets("Somiera").Ra nge("A1:F15") 'verificat WB.Worksheets("PAL ROWENI").Range("A6:AR100").Copy _ Destination:=ThisWorkbook.Worksheets("PAL ROWENI").Range("A6:AR100") 'verificat* WB.Worksheets("MDF ROWENI").Range("A7:AP100").Copy _ Destination:=ThisWorkbook.Worksheets("MDF ROWENI").Range("A7:AP100") 'verificat* WB.Worksheets("Furnire ROWENI").Range("A6:BD100").Copy _ Destination:=ThisWorkbook.Worksheets("Furnire ROWENI").Range("A6:BD100") 'verificat* ' close the sourse workbook WB.Close SaveChanges:=False End Sub -------------------- Code: -------------------- SUB SALVARE() 'Retrieve file name to use for Save fileSaveName = Application.GetSaveAsFilename( _ FileFilter:="Excel Files (*.xls), *.xls") 'If user specified file name, perform Save and display msgbox If fileSaveName < False Then ActiveWorkbook.SaveAs filename:=fileSaveName, FileFormat:=xlNormal MsgBox "Fisier salvat in:" & fileSaveName End If End Sub -------------------- Code: -------------------- SUB EXPORT_RAND_DIN_FISA() Dim file As String Dim SupplyFile As Workbook Dim TrgtFile As Variant Dim Sht1 As String Dim Rw As Integer ChDrive "c:\" '<<< CHANGE ChDir "C:\Documents and Settings\Vasnic\Desktop\" '<<< CHANGE file = ActiveWorkbook.Name ' to save workbook name Sht1 = ActiveSheet.Name ' to save the sheet name TrgtFile = Application.GetOpenFilename("Excel Files (*.xls), *.xls") If TrgtFile = False Then Exit Sub End If Set SupplyFile = Workbooks.Open(filename:=TrgtFile) Rw = Application.InputBox("Selectati randul unde se vor exporta datele", Type:=8).Row ' To Bring the required row With ActiveSheet .Range("B" & Rw) = Workbooks(file).Sheets(Sht1).Range("D7") .Range("C" & Rw) = Workbooks(file).Sheets(Sht1).Range("D10") .Range("G" & Rw) = Workbooks(file).Sheets(Sht1).Range("D12") .Range("H" & Rw) = Workbooks(file).Sheets(Sht1).Range("D15") .Range("K" & Rw) = Workbooks(file).Sheets(Sht1).Range("D98") .Range("O" & Rw) = Workbooks(file).Sheets(Sht1).Range("D119") .Range("U" & Rw) = Workbooks(file).Sheets(Sht1).Range("J51") .Range("Z" & Rw) = Workbooks(file).Sheets(Sht1).Range("D121") End With End Sub -------------------- Ok. That's about it. So i would like the script to work in the following fashion: Subimportlocal - MessageBox (Is everything ok?? YES/NO). If YES then Sub Salvare and then Sub Export_rand_din_fisa - End. If No - End. I tried myself sevaral things but didn't work. So any help would be apreciated. Thank you! -- adinic ------------------------------------------------------------------------ adinic's Profile: http://www.excelforum.com/member.php...o&userid=31529 View this thread: http://www.excelforum.com/showthread...hreadid=558359 |
several scripts in one single script
Yes, that works but i needed the message box between the sub called import local and the sub called salvare, as i said at the end of the first post.:rolleyes: Thank you! -- adinic ------------------------------------------------------------------------ adinic's Profile: http://www.excelforum.com/member.php...o&userid=31529 View this thread: http://www.excelforum.com/showthread...hreadid=558359 |
several scripts in one single script
You expect help with comments like that? Aren't you capable of adding that
trivial touch? -- HTH Bob Phillips (replace somewhere in email address with gmail if mailing direct) "adinic" wrote in message ... Yes, that works but i needed the message box between the sub called import local and the sub called salvare, as i said at the end of the first post.:rolleyes: Thank you! -- adinic ------------------------------------------------------------------------ adinic's Profile: http://www.excelforum.com/member.php...o&userid=31529 View this thread: http://www.excelforum.com/showthread...hreadid=558359 |
several scripts in one single script
If i have offended you in any way i am sorry! If i knew how to add that trivial touch i wouldn't be asking! Thank you for your help! -- adinic ------------------------------------------------------------------------ adinic's Profile: http://www.excelforum.com/member.php...o&userid=31529 View this thread: http://www.excelforum.com/showthread...hreadid=558359 |
several scripts in one single script
oh, the power of looking on google. or the help file. or old posts.
i'll give you a hint: there is this little function called msgbox. look it up. lazy noobs ::rolls eyes:: adinic wrote: If i have offended you in any way i am sorry! If i knew how to add that trivial touch i wouldn't be asking! Thank you for your help! -- adinic ------------------------------------------------------------------------ adinic's Profile: http://www.excelforum.com/member.php...o&userid=31529 View this thread: http://www.excelforum.com/showthread...hreadid=558359 |
several scripts in one single script
Already did that. And came up with this code : Code: -------------------- Sub MessageBox() importlocal If MsgBox("Is everything OK?", vbYesNo) = vbYes Then Salvare export_rand_din_fisa End If End Sub -------------------- The problem is that after the message box appears i need to be able to scroll down the file and i cannot do that. Is there a parameter for this function that sends the message box in the background so that i can work on the file? Thank you! -- adinic ------------------------------------------------------------------------ adinic's Profile: http://www.excelforum.com/member.php...o&userid=31529 View this thread: http://www.excelforum.com/showthread...hreadid=558359 |
several scripts in one single script
Already did that. And came up with this code : Code: -------------------- Sub MessageBox() importlocal If MsgBox("Is everything OK?", vbYesNo) = vbYes Then Salvare export_rand_din_fisa End If End Sub -------------------- The problem is that after the message box appears i need to be able to scroll down the file and i cannot do that. Is there a parameter for this function that sends the message box in the background so that i can work on the file? Thank you! -- adinic ------------------------------------------------------------------------ adinic's Profile: http://www.excelforum.com/member.php...o&userid=31529 View this thread: http://www.excelforum.com/showthread...hreadid=558359 |
several scripts in one single script
msgbox's are modal. you are going to need to create a modeless userform
to do this. look in your help files or google for ideas. did your eyes get tired or something? i didn;t notice them rolling this time. did you finally realize that we are here to help, for free, and under no obligation to do anything? adinic wrote: Already did that. And came up with this code : Code: -------------------- Sub MessageBox() importlocal If MsgBox("Is everything OK?", vbYesNo) = vbYes Then Salvare export_rand_din_fisa End If End Sub -------------------- The problem is that after the message box appears i need to be able to scroll down the file and i cannot do that. Is there a parameter for this function that sends the message box in the background so that i can work on the file? Thank you! -- adinic ------------------------------------------------------------------------ adinic's Profile: http://www.excelforum.com/member.php...o&userid=31529 View this thread: http://www.excelforum.com/showthread...hreadid=558359 |
several scripts in one single script
No, but this might work for you
Sub MessageBox() importlocal ans = Application.InputBox("Is everything OK? (Type yes or no)", Type:=2) if LCase(ans) = "yes" Then Salvare export_rand_din_fisa End If End Sub -- HTH Bob Phillips (replace somewhere in email address with gmail if mailing direct) "adinic" wrote in message ... Already did that. And came up with this code : Code: -------------------- Sub MessageBox() importlocal If MsgBox("Is everything OK?", vbYesNo) = vbYes Then Salvare export_rand_din_fisa End If End Sub -------------------- The problem is that after the message box appears i need to be able to scroll down the file and i cannot do that. Is there a parameter for this function that sends the message box in the background so that i can work on the file? Thank you! -- adinic ------------------------------------------------------------------------ adinic's Profile: http://www.excelforum.com/member.php...o&userid=31529 View this thread: http://www.excelforum.com/showthread...hreadid=558359 |
All times are GMT +1. The time now is 12:07 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com