Jump to content

SUBIECTE NOI
« 1 / 5 »
RSS
Radio care se incinge

problema -amplificator cu tranzis...

Retragere bani din cont inainte d...

Plata cu cardu si bacsisu
 Primire bani din Danemarca prin N...

Alerta securitate Fedora Linux 40...

Problemuțe sistem audio ma&#...

Renovare balcon
 installation has failed there was...

Montura polara.....

Sfat inchiriere locuinta unei per...

Sursa stereo -> amplif mono
 Dan Blondu vs. Marian Piciu

Side - Antalya

Nume fetita - international dar c...

A fost lansat MX Linux 23.3
 

Buton Save and Exit

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

#1
xymzar

xymzar

    Senior Member

  • Grup: Senior Members
  • Posts: 9,667
  • Î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,667
  • Înscris: 14.10.2004
Multumesc Romi acum incep testarea

Anunturi

Chirurgia cranio-cerebrală minim invazivă Chirurgia cranio-cerebrală minim invazivă

Tehnicile minim invazive impun utilizarea unei tehnologii ultramoderne.

Endoscoapele operatorii de diverse tipuri, microscopul operator dedicat, neuronavigația, neuroelectrofiziologia, tehnicile avansate de anestezie, chirurgia cu pacientul treaz reprezintă armamentarium fără de care neurochirurgia prin "gaura cheii" nu ar fi posibilă. Folosind tehnicile de mai sus, tratăm un spectru larg de patologii cranio-cerebrale.

www.neurohope.ro

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