从 VBA 到 vb NET 的翻译程序
Translation program from VBA to vb NET
通常我在 Excel 中将此工作程序作为宏,我想将其提取为一个简单的按钮 windows 应用程序。有没有一种简单的方法可以做到这一点,或者更好地尝试识别 VBA 和 VB.Net 之间的差异并尝试从头开始编写它?
Sub Zapisywanie_txt_Biesse_WR()
Dim TextFile As Integer
Dim FilePath As String
Dim FileContent As String, strContent() As String
Dim NewName As String
Dim StrFile As String
Dim FileNum As String
Dim Last_Dot As Long
Dim posStart As Integer
Dim posLength As Integer
Dim i As Integer
Dim j As Integer
Dim LPX As Integer
Dim MyTxtFile
On Error GoTo ErrorHandle
'Zmienic domyslna lokacje na lokacje aplikacji
'ChDir "C:\Users\marcin.perz\Desktop\makro zmieniajace pliki"
ChDir ActiveWorkbook.Path
'Spytac sie o plik do przerobienia
FilePath = Application.GetOpenFilename("Text Files (*.txt),*.txt")
'Nastepny wolny numer dla txt
TextFile = FreeFile
'Otworzenie txt w trybie odczytu
Open FilePath For Input As TextFile
'Zapisanie zawartosci pliku do pamieci
FileContent = Input(LOF(TextFile), TextFile)
'Zamkniecie pliku
Close TextFile
'Znajdz/zamien prcedury
FileContent = Replace(FileContent, "campoD0=LABL,A,4,4,NULL,0,0", "campoD0=LABL,A,4,4,NULL,0,0")
FileContent = Replace(FileContent, "campoD1=PROG,A,256,8,NULL,0,2", "campoD1=PROG,A,256,8,NULL,0,2")
FileContent = Replace(FileContent, "campoD2=QNTA,U,4,4,NULL,0,0", "campoD2=QNTA,U,4,4,NULL,0,0")
FileContent = Replace(FileContent, "campoD3=CONT,U,4,4,NULL,0,0", "campoD3=CONT,U,4,4,NULL,0,0")
FileContent = Replace(FileContent, "campoD4=COMM,A,768,80,NULL,0,0", "campoD4=COMM,A,768,80,NULL,0,0")
FileContent = Replace(FileContent, "ORDRE", "$ ORDRE")
FileContent = Replace(FileContent, "," & vbCrLf, " $, " & vbCrLf)
'Nastepny wolny numer dla txt
TextFile = FreeFile
'Nadanie nowej nazwy lokazcji
Last_Dot = InStrRev(FilePath, ".")
NewName = Left$(FilePath, Last_Dot - 1) & "_rover35" & Mid$(FilePath, Last_Dot)
FilePath = NewName
'Otworzenie txt w trybie zapisu
Open FilePath For Output As TextFile
'Zapisanie zmienionej zawartosci do pliku
Print #TextFile, FileContent
'Zakmniecie pliku
Close TextFile
'~~> Podzielenie pliku na linie binarnie
Open FilePath For Binary As #1
FileContent = Space$(LOF(1))
Get #1, , FileContent
Close #1
strContent() = Split(FileContent, vbCrLf)
' Here i will do some conditional replecments split text into an array by lines etc.
'Polaczenie pliku
FileContent = Join(strContent, vbCrLf)
'Otworzenie txt w trybie zapisu
Open FilePath For Output As TextFile
'Zapisanie zmienionej zawartosci do pliku
Print #TextFile, FileContent
'Zakmniecie pliku
Close TextFile
MyTxtFile = Shell("C:\WINDOWS\notepad.exe " & FilePath, 1)
'etykieta wyjscia z programu
BeforeExit:
'wyjscie z programu
Exit Sub
'etykieta radzenia sobie z bledami
ErrorHandle:
MsgBox Err.Description
'skierowanie do wyjscia z programu
Resume BeforeExit
'koniec makra
End Sub
您可以尝试以下方法之一:
- 将代码复制到 VB.NET Windows 表单中,边做边改正错误
- 安装 VB6 并将代码粘贴到项目中(因为 VBA 是 VB6 代码)。然后尝试打开 VB.NET 中的 VB6 项目,此时它将为您执行升级过程
祝你好运。
通常我在 Excel 中将此工作程序作为宏,我想将其提取为一个简单的按钮 windows 应用程序。有没有一种简单的方法可以做到这一点,或者更好地尝试识别 VBA 和 VB.Net 之间的差异并尝试从头开始编写它?
Sub Zapisywanie_txt_Biesse_WR()
Dim TextFile As Integer
Dim FilePath As String
Dim FileContent As String, strContent() As String
Dim NewName As String
Dim StrFile As String
Dim FileNum As String
Dim Last_Dot As Long
Dim posStart As Integer
Dim posLength As Integer
Dim i As Integer
Dim j As Integer
Dim LPX As Integer
Dim MyTxtFile
On Error GoTo ErrorHandle
'Zmienic domyslna lokacje na lokacje aplikacji
'ChDir "C:\Users\marcin.perz\Desktop\makro zmieniajace pliki"
ChDir ActiveWorkbook.Path
'Spytac sie o plik do przerobienia
FilePath = Application.GetOpenFilename("Text Files (*.txt),*.txt")
'Nastepny wolny numer dla txt
TextFile = FreeFile
'Otworzenie txt w trybie odczytu
Open FilePath For Input As TextFile
'Zapisanie zawartosci pliku do pamieci
FileContent = Input(LOF(TextFile), TextFile)
'Zamkniecie pliku
Close TextFile
'Znajdz/zamien prcedury
FileContent = Replace(FileContent, "campoD0=LABL,A,4,4,NULL,0,0", "campoD0=LABL,A,4,4,NULL,0,0")
FileContent = Replace(FileContent, "campoD1=PROG,A,256,8,NULL,0,2", "campoD1=PROG,A,256,8,NULL,0,2")
FileContent = Replace(FileContent, "campoD2=QNTA,U,4,4,NULL,0,0", "campoD2=QNTA,U,4,4,NULL,0,0")
FileContent = Replace(FileContent, "campoD3=CONT,U,4,4,NULL,0,0", "campoD3=CONT,U,4,4,NULL,0,0")
FileContent = Replace(FileContent, "campoD4=COMM,A,768,80,NULL,0,0", "campoD4=COMM,A,768,80,NULL,0,0")
FileContent = Replace(FileContent, "ORDRE", "$ ORDRE")
FileContent = Replace(FileContent, "," & vbCrLf, " $, " & vbCrLf)
'Nastepny wolny numer dla txt
TextFile = FreeFile
'Nadanie nowej nazwy lokazcji
Last_Dot = InStrRev(FilePath, ".")
NewName = Left$(FilePath, Last_Dot - 1) & "_rover35" & Mid$(FilePath, Last_Dot)
FilePath = NewName
'Otworzenie txt w trybie zapisu
Open FilePath For Output As TextFile
'Zapisanie zmienionej zawartosci do pliku
Print #TextFile, FileContent
'Zakmniecie pliku
Close TextFile
'~~> Podzielenie pliku na linie binarnie
Open FilePath For Binary As #1
FileContent = Space$(LOF(1))
Get #1, , FileContent
Close #1
strContent() = Split(FileContent, vbCrLf)
' Here i will do some conditional replecments split text into an array by lines etc.
'Polaczenie pliku
FileContent = Join(strContent, vbCrLf)
'Otworzenie txt w trybie zapisu
Open FilePath For Output As TextFile
'Zapisanie zmienionej zawartosci do pliku
Print #TextFile, FileContent
'Zakmniecie pliku
Close TextFile
MyTxtFile = Shell("C:\WINDOWS\notepad.exe " & FilePath, 1)
'etykieta wyjscia z programu
BeforeExit:
'wyjscie z programu
Exit Sub
'etykieta radzenia sobie z bledami
ErrorHandle:
MsgBox Err.Description
'skierowanie do wyjscia z programu
Resume BeforeExit
'koniec makra
End Sub
您可以尝试以下方法之一:
- 将代码复制到 VB.NET Windows 表单中,边做边改正错误
- 安装 VB6 并将代码粘贴到项目中(因为 VBA 是 VB6 代码)。然后尝试打开 VB.NET 中的 VB6 项目,此时它将为您执行升级过程
祝你好运。