|
都是全角忍的祸！
重新调整了一下思路，请看附件：
以下代码供参考：
'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By I Love You_Word!@ExcelHome 2005-4-13 12:38:17
'仅测试于System: Windows NT Word: 10.0 Language: 2052
'^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Option Explicit
'此程序的作用为指定单元格中文本的相同长度,不足处以空格填充.
'在本程序中,设定的第一列的文本长度为8个字符长度,第二列的文本
'长度为36个字符长度.请根据实际情况,略作修改,以确保有效对齐文本
'可以更改或者指定文本文件的文件夹位置,或者通过代码,或者可以通过
'修改WORD/工具/选项/文件夹位置/文档文件夹位置实现
Sub SaveAsTxt()
Dim Mystring As String, txtFileName As String, MyDoc As Document
Dim aCell As Cell, A As Range, B As Range, C As String, HzCount As Integer
Dim aChar As Range, D As String, E As String
Application.ScreenUpdating = False '关闭屏幕更新
With ThisDocument '本文档
'取得第一个段落的文本(可作为文件名使用)
txtFileName = .Range(.Paragraphs(1).Range.Start, .Paragraphs(1).Range.End - 1)
For Each aCell In .Tables(1).Columns(2).Cells '在第二列的单元格循环
'定义一个RANGE对象
Set A = .Range(aCell.Previous.Range.Start, aCell.Previous.Range.End - 1)
HzCount = 0
For Each aChar In A.Characters
'统计中文字符数
If Asc(aChar) < 0 Then HzCount = HzCount + 1
Next
'定义该文本型变量为8个字符长度,不足处以空格填充
D = A & VBA.Space(8 - (Len(A.Text) - HzCount) - HzCount * 2)
'定义一个RANGE对象
Set B = .Range(aCell.Range.Start, aCell.Range.End - 1)
HzCount = 0
For Each aChar In B.Characters
If Asc(aChar) < 0 Then HzCount = HzCount + 1
Next
'定义该文本型变量为36个字符长度,不足处以空格填充
E = B & VBA.Space(36 - (Len(B.Text) - HzCount) - HzCount * 2)
'定义一个文本型变量,其值为下一个单元格中的文本
C = .Range(aCell.Next.Range.Start, aCell.Next.Range.End - 1).Text
'在内存中累加文本并加入段落标记
Mystring = Mystring & D & E & C & Chr(13)
Next
End With
Set MyDoc = Documents.Add
With MyDoc
'在正文起点处插入文本变量mystring
.Range(0, 0).InsertAfter Mystring
'在正文起点处插入源文档的第一个段落文本
.Range(0, 0).InsertAfter txtFileName & Chr(13)
.Content.Font.Name = "宋体" '设置字体格式
.Content.Font.Size = 12 '设置字号
'全部更正为全角符号,以利对齐
'防止文件名出错,终止错误处理
'当出现出错对话框后,您可以将新建的WORD文档另存为一个纯文本文件
Application.ScreenUpdating = True '恢复屏幕更新
On Error GoTo 0
'另存为纯文本文件,如果需要修改文件夹位置,可在此处指定
'默认情况下,为WORD/工具/选项/文件夹位置/文档中指定的文件夹路径
.SaveAs FileName:=txtFileName, FileFormat:=wdFormatText
MsgBox "此文本文件的全文件名为" & .FullName, vbOKOnly + vbInformation
.Close '关闭该文档
End With
End Sub
'----------------------
注意：您的记事本的格式请调整后宋体，12号，以后就是默认的这个格式了。好了，不多说了，做着看吧！
zF08nhYB.zip
(23.31 KB, 下载次数: 30)
| 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2005-4-12 12:56
楼主
再一次感谢守柔,您辛苦了!