Excel'de Mutlak yollar yerine göreceli olarak VBA

Question

Verileri hesaplamaları yapmadan önce bir HTML dosyasından (yerel olarak depolanan) veri alan bir Excel VBA makrosu yazdım. HTML dosyası mutlak bir yol ile anılır anda

:

Ben dağıtmak istiyorum, çünkü bu (mutlak aksine buna bakmaya göreli bir yol kullanmak istediğiniz Ancak

Workbooks.Open FileName:="C:\Documents and Settings\Senior Caterer\My Documents\Endurance Calculation\TRICATEndurance Summary.html" 

aynı klasör yapısını kullanamayan çalışma arkadaşlarına elektronik tablo). Html dosyası ve excel elektronik tablo aynı klasörde otururken, bunun zor olacağını düşünmemiştim, ancak bunu tamamen yapamıyorum. İnternette arama yaptım ve önerilen çözümler çok karmaşık görünüyor.

Excel 2000 ve 2002'yi iş başında kullanıyorum, ancak dağıtmayı planlarken mümkün olduğu kadar çok Excel sürümüyle çalışmasını isterim.

Minnetle alınan her türlü öneri.

Answer 1

Workbooks.Open FileName:= ThisWorkbook.Path & "\TRICATEndurance Summary.html" 

Sen yaparak kullanıcılara daha fazla esneklik sağlayabilir

Answer 2

Sen göreli yol kökü bunlardan birini kullanabilirsiniz:

ActiveWorkbook.Path 
ThisWorkbook.Path 
App.Path 

Answer 3

Ben sorun "geçerli dizin" doğru ayarlanmış olup olmadığını bir yolu olmadan dosya açılması sadece çalışacağını düşünüyorum.

Örnek Pencerede "Debug.Print CurDir" yazmayı deneyin - bu, Araçlar ... Seçenekler bölümünde ayarlanan varsayılan dosyalarınızın konumunu göstermelidir.

Ben biraz eski VB komutunun var belki de, onunla tamamen mutluyum emin değilim ama bunu:

ChDir ThisWorkbook.Path 

ben ThisWorkbook kullanmayı tercih ediyorum. HTML dosyasına bir yol oluşturma yolu. Ben (her zaman yüklenecek görünüyor) komut dosyası Runtime FileSystemObject büyük bir hayranıyım, bu yüzden (Microsoft Komut Runtime bir başvuru ayarladıktan sonra) böyle bir şey yapmak için daha mutlu olurdum:

Const HTML_FILE_NAME As String = "my_input.html" 

With New FileSystemObject 
    With .OpenTextFile(.BuildPath(ThisWorkbook.Path, HTML_FILE_NAME), ForReading) 
     ' Now we have a TextStream object that we can use to read the file 
    End With 
End With 

Answer 4

onlara

Private Sub btn_browser_file_Click() 
Dim xRow As Long 
Dim sh1 As Worksheet 
Dim xl_app As Excel.Application 
Dim xl_wk As Excel.Workbook 
Dim WS As Workbook 
Dim xDirect$, xFname$, InitialFoldr$ 
InitialFoldr$ = "C:\" 
With Application.FileDialog(msoFileDialogFolderPicker) 
    .InitialFileName = Application.DefaultFilePath & "\" 
    .Title = "Please select a folder to list Files from" 
    .InitialFileName = InitialFoldr$ 
    .Show 
    Range("H13").Activate 
    If .SelectedItems.Count <> 0 Then 
     xDirect$ = .SelectedItems(1) & "\" 
     Range("h12").Value = xDirect$ 
     xFname$ = Dir(xDirect$, 7) 
     Do While xFname$ <> "" 
     If (Format(FileDateTime(xDirect$ & "\" & xFname$), "MM/DD/YYYY") > Format(Range("H10").Value, "MM/DD/YYYY")) Then 
      ActiveCell.Offset(xRow) = xFname$ 
      xRow = xRow + 1 
      xFname$ = Dir 
      Else 
      xFname$ = Dir 
      xRow = xRow 
     End If 
     Loop 
    End If 
End With 

için Tarayıcı Düğmesi sağlar:

Sadece yalestar bu size göreli yol verecektir söylediklerini açıklığa kavuşturmak için Bu kod parçası ile 10

, bunu kolayca yapabilirsiniz. Test edilmiş kod

Answer 5

Bunun yardımcı olabileceğini düşünüyorum. Makro'nun altında, klasör varsa, klasörü oluşturmaz ve bu klasördeki xls ve pdf biçimlerini kaydetmez. Klasörün ilgili kişilerle paylaşıldığı ve böylece herkesin güncellendiği görülür.

Sub PDF_laudo_e_Prod_SP_Sem_Ajuste_Preco() 
' 
' PDF_laudo_e_Prod_SP_Sem_Ajuste_Preco Macro 
' 

' 


Dim MyFolder As String 
Dim LaudoName As String 
Dim NF1Name As String 
Dim OrigFolder As String 

MyFolder = ThisWorkbook.path & "\" & Sheets("Laudo").Range("C9") 
LaudoName = Sheets("Laudo").Range("K27") 
NF1Name = Sheets("PROD SP sem ajuste").Range("Q3") 
OrigFolder = ThisWorkbook.path 

Sheets("Laudo").Select 
Columns("D:P").Select 
Selection.EntireColumn.Hidden = True 

If Dir(MyFolder, vbDirectory) <> "" Then 
Sheets("Laudo").ExportAsFixedFormat Type:=xlTypePDF, filename:=MyFolder & "\" & LaudoName & ".pdf", Quality:=xlQualityMinimum, _ 
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _ 
False 

Sheets("PROD SP sem ajuste").ExportAsFixedFormat Type:=xlTypePDF, filename:=MyFolder & "\" & NF1Name & ".pdf", Quality:=xlQualityMinimum, _ 
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _ 
False 

ThisWorkbook.SaveAs filename:=MyFolder & "\" & LaudoName 

Application.DisplayAlerts = False 

ThisWorkbook.SaveAs filename:=OrigFolder & "\" & "Entregas e Instrucao Barter 2015 - beta" 

Application.DisplayAlerts = True 

Else 
MkDir MyFolder 
Sheets("Laudo").ExportAsFixedFormat Type:=xlTypePDF, filename:=MyFolder & "\" & LaudoName & ".pdf", Quality:=xlQualityMinimum, _ 
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _ 
False 

Sheets("PROD SP sem ajuste").ExportAsFixedFormat Type:=xlTypePDF, filename:=MyFolder & "\" & NF1Name & ".pdf", Quality:=xlQualityMinimum, _ 
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _ 
False 

ThisWorkbook.SaveAs filename:=MyFolder & "\" & LaudoName 

Application.DisplayAlerts = False 

ThisWorkbook.SaveAs filename:=OrigFolder & "\" & "Entregas e Instrucao Barter 2015 - beta" 

Application.DisplayAlerts = True 

End If 

Sheets("Laudo").Select 
Columns("C:Q").Select 
Selection.EntireColumn.Hidden = False 
Range("A1").Select 

End Sub