Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]() 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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
delete scripts | Excel Worksheet Functions | |||
Forumlas or scripts? | Excel Discussion (Misc queries) | |||
SQL Scripts in Excel | Excel Discussion (Misc queries) | |||
SQL scripts and ODBC | Excel Programming | |||
Macintosh and VB Scripts | Excel Programming |