[已解决]VBA批量设置当前工作表中，文本框格式

yjwdjfqb

VBA批量设置当前工作表中，文本框格式
1、文本框无连线

2、文本框无填充色

3、文本框文字。三号、黑体、红色

请朋友们帮帮忙，谢谢大家了

VBA批量设置文本框格式.rar (1.87 KB, 下载次数: 33)

2014-5-18 15:46 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

dsmch

2014-5-18 16:01

1. Sub Macro1()
   
2. For Each m In ActiveSheet.Shapes
   
3.     m.Select
   
4.     With Selection.Font
   
5.         .Name = "黑体"
   
6.         .Size = 10
   
7.         .ColorIndex = 3
   
8.     End With
   
9.     Selection.ShapeRange.Fill.Transparency = 1
   
10.     Selection.ShapeRange.Line.Visible = msoFalse
    
11. Next
    
12. End Sub
    

复制代码

跳转到最佳答案楼层

冥王

录制一个宏：定位——对象——再设置文本框的格式

dsmch

1. Sub Macro1()
   
2. For Each m In ActiveSheet.Shapes
   
3.     m.Select
   
4.     With Selection.Font
   
5.         .Name = "黑体"
   
6.         .Size = 10
   
7.         .ColorIndex = 3
   
8.     End With
   
9.     Selection.ShapeRange.Fill.Transparency = 1
   
10.     Selection.ShapeRange.Line.Visible = msoFalse
    
11. Next
    
12. End Sub
    

复制代码

yjwdjfqb

dsmch 发表于 2014-5-18 16:01

老师你好，能不能加个语句，让文本框的大小自动适应文字的的宽度和高度，

谢谢老师了！

无聊的疯子

录的代码改的

1. 
   
2. Sub cc()
   
3. Dim Sh As Shape
   
4.   For Each Sh In Sheet1.Shapes
   
5.     If InStr(Sh.Name, "Text") > 0 Then
   
6.       Sh.Fill.Visible = msoFalse
   
7.       Sh.Line.Visible = msoFalse
   
8.       With Sh.TextFrame2.TextRange.Font
   
9.         .Fill.ForeColor.RGB = RGB(255, 0, 0)
   
10.         .NameFarEast = "黑体"
    
11.         .Size = 30
    
12.       End With
    
13.     End If
    
14.   Next
    
15. End Sub
    

复制代码

无聊的疯子

yjwdjfqb 发表于 2014-5-18 16:15
老师你好，能不能加个语句，让文本框的大小自动适应文字的的宽度和高度，

谢谢老师了！

在循环里面添加一句

1. 
   
2. Sh.Placement = xlMoveAndSize
   

复制代码

yjwdjfqb

dsmch 发表于 2014-5-18 16:01

老师你好，我加上这个，怎么会出错呢

就是文字水平居中

和垂直居中

.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.ReadingOrder = xlContext
.Orientation = xlHorizontal

dsmch

1. Sub Macro1()
   
2. For Each m In ActiveSheet.Shapes
   
3.     m.Select
   
4.     With Selection.Font
   
5.         .Name = "黑体"
   
6.         .Size = 30
   
7.         .ColorIndex = 3
   
8.     End With
   
9.     With Selection
   
10.         .ShapeRange.Fill.Transparency = 1
    
11.         .ShapeRange.Line.Visible = msoFalse
    
12.         .HorizontalAlignment = xlCenter
    
13.         .VerticalAlignment = xlCenter
    
14.         .AutoSize = True
    
15.     End With
    
16. Next
    
17. End Sub
    

复制代码

yjwdjfqb

dsmch 发表于 2014-5-18 16:01

老师你好，我这个附件中，要出错，
如果，删除除文本框外的其它对象外，就不出错，
怎样让，有其它对象时，也能正确的执行命令
在这个里面要出错.rar (16.78 KB, 下载次数: 15)

2014-5-18 17:29 上传

点击文件名下载附件

dsmch

Sub 批量设置文本框格式()
    For Each myTXT In ActiveSheet.Shapes    '循环当前工作表所有的文本框（Shapes文本框）
       If myTXT.Name Like "Text Box*" Then
            myTXT.Select    '选择所有文本框
            '设置选中的字体格式
            With Selection.Font
                .Name = "黑体"    '字体
                .Size = 10    '字体大小
                .ColorIndex = 0    '字体颜色
            End With
            '设置选中的文本框格式
            With Selection
                .ShapeRange.Fill.Transparency = 1    '无填充色
                .ShapeRange.Line.Visible = msoFalse    '无边框
                .HorizontalAlignment = xlCenter    '垂直居中
                .VerticalAlignment = xlCenter    '水平居中
                .AutoSize = True    '自动适应大小
            End With
        End If
    Next
End Sub