Jump to content

SUBIECTE NOI
« 1 / 5 »
RSS
Redenumire extensii la mai multe ...

laptop nefuncțional dupa act...

Animatii lacrimogene: Grave of th...

Prize audio - merita sau nu?!
 Segregare beton(stalpi)

Cum pot sa creez imagini de calit...

Probleme cu o firma de lucrari, c...

JOKER 2: Folie à Deux (2024)
 Achizitionare EdgeRouter X si AP ...

Phising pe Autovit

ANCOM propune dereglementarea pie...

Viespi, viespi, viespi
 Teapa abonament vodafone

Aplicatie blacklist cu mesagerie ...

Socul viitorului

Probleme pornire 1.6 TDI CLHA
 

Buton Save and Exit

- - - - -
  • Please log in to reply
2 replies to this topic

#1
xymzar

xymzar

    Senior Member

  • Grup: Senior Members
  • Posts: 9,256
  • Înscris: 14.10.2004
Salut tuturor,am urmatoarea problema.Mentionez ca sunt paralel cu VBA-ul :confuzzled:
Intr-un excel am un buton care:
- salveaza excel-ul respectiv
- unul din  sheet-uri il salveaza in format txt
- inchide excel-ul
Acum ce doresc eu, daca se poate, ar trebui adaugata o linie care sa creeeze un director cu numele excelului si sa duca excel-ul si txt-ul in el. In momentul de fata le salveaza in radacina.
Asa arata acum codul:

Private Sub CommandButton1_Click()
    Dim Wdate, Wname, Wresp
    Sheets("MIDAS").Select
    Wdate = ActiveSheet.Range("A2").Value
    Sheets("BN_codificat").Select
    Wname = ThisWorkbook.Path() & "\" & Mid(ActiveWorkbook.Name, 1, 3) & "s" & Mid(Wdate, 1, 2) & Mid(Wdate, 4, 2)
    If IsEmpty(Wdate) Then
    Wresp = MsgBox("nu sunt date", vbOKOnly)
    Else
        ActiveWorkbook.SaveAs Filename:=Wname & ".340", _
        FileFormat:=xlTextPrinter, CreateBackup:=False
        ActiveSheet.Name = "BN_codificat"
        Sheets("BN_explicit").Select
        ActiveWorkbook.SaveAs Filename:=Wname & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
        Application.Quit
    End If
       MsgBox "Salvare Reusita"
End Sub

Multumesc mult

Sa creez folderul am reusit
Dar cum sa ii dau numele excel-ului si sa le salveze in noul director inca nu.Mai sap

Edited by xymzar, 03 February 2006 - 21:51.


#2
romi

romi

    Junior Member

  • Grup: Members
  • Posts: 96
  • Înscris: 20.05.2005
salut,
iti timit mai jos niste rutine scrise de mine mai demult (ultima apartine unui amic) care au darul de a te familiariza cu operatiile ce tin de fiiere si directoare; numele lor sunt destul de sugestive asa ca ma scutesc de comentarii; dc ai MSDN cauta SaveAs, bafta

Public Sub CopyFileInDir(strFileName As String, strDirName As String)
	Dim ob As Object
	Set ob = CreateObject("Scripting.FilesystemObject")
	ob.CopyFile strFileName, strDirName
	Set ob = Nothing
End Sub

Public Sub CopyFile(strOldName As String, strNewName As String)
	Dim ob As Object
	Set ob = CreateObject("Scripting.FilesystemObject")
	ob.CopyFile strOldName, strNewName
	Set ob = Nothing
End Sub

Public Sub DeleteFile(strName As String)
	Dim ob As Object
	Set ob = CreateObject("Scripting.FilesystemObject")
	ob.DeleteFile strName
	Set ob = Nothing
End Sub

Public Sub CreateDir(strDirPath As String)
	Dim ob As Object
	Set ob = CreateObject("Scripting.FilesystemObject")
	If Dir(strDirPath, vbDirectory) = "" Then
		ob.CreateFolder (strDirPath)
	Else
		MsgBox "Directory Exist"
	End If
	Set ob = Nothing
End Sub

' diverse operatii in Excel
Public Function ExcelFile(strPathFile As String) As Boolean
	Dim xlApp As New Excel.Application
	Dim xlBook As Excel.Workbook
	Dim xlSheet As Excel.Worksheet
		
	If Dir(strPathFile) <> "" Then
		Set xlApp = New Excel.Application
		Set xlBook = xlApp.Workbooks.Open(strPathFile)
		Set xlSheet = xlBook.Worksheets(1)
	
		xlBook.Sheets(1).Cells(1, 2) = 10
		
		xlSheet.Name = "anda"
		
		xlBook.Save
		xlBook.Close
		xlApp.Quit
		
		Set xlSheet = Nothing
		Set xlBook = Nothing
		Set xlApp = Nothing
		
		ExcelFile = True
	Else
		'MsgBox "Nu exista fisierul.", vbCritical, strE
		ExcelFile = False
	End If
End Function

' This procedure creates a new workbook file and saves it by using the path
' and name specified in the strBookName argument. You use the intNumsheets
' argument to specify the number of worksheets in the workbook;
' the default is 3.
Public Function CreateNewWorkbook(strBookName As String, _
	  intNumSheets As Integer) As Workbook
   
	Dim xlApp As New Excel.Application
	Dim intOrigNumSheets As Integer
	Dim wkbNew As Excel.Workbook
	
	On Error GoTo CreateNew_Err
   
	intOrigNumSheets = Application.SheetsInNewWorkbook
	If intOrigNumSheets <> intNumSheets Then
		Application.SheetsInNewWorkbook = intNumSheets
	End If
	
	Set wkbNew = Workbooks.Add
	If Len(strBookName) = 0 Then strBookName = Application.GetSaveAsFilename
	wkbNew.SaveAs strBookName
	Set CreateNewWorkbook = wkbNew
	Application.SheetsInNewWorkbook = intOrigNumSheets
	
	xlApp.Quit
   
CreateNew_End:
	Exit Function
CreateNew_Err:
	Set CreateNewWorkbook = Nothing
	wkbNew.Close False
	Set wkbNew = Nothing
	Resume CreateNew_End
End Function


#3
xymzar

xymzar

    Senior Member

  • Grup: Senior Members
  • Posts: 9,256
  • Înscris: 14.10.2004
Multumesc Romi acum incep testarea

Anunturi

Bun venit pe Forumul Softpedia!

0 user(s) are reading this topic

0 members, 0 guests, 0 anonymous users

Forumul Softpedia foloseste "cookies" pentru a imbunatati experienta utilizatorilor Accept
Pentru detalii si optiuni legate de cookies si datele personale, consultati Politica de utilizare cookies si Politica de confidentialitate