RE:Guardar un Proyecto por codigo
Keyascii = Eso que ? No sirve de nada
Por fin termine uno que cambia pero solo un formulario.. solo seria cuestio nde modificarlo por ejemplo con un control File para asi seleccionar el archivo *.frm a modificar
Pon un combobox para que se pongan las fuentes, un textbox con el archivo y un boton
Private Sub Agrega()
Text2 = Text2 & "BeginProperty Font" & vbCrLf
Text2 = Text2 & "Name = " & Chr(34) & Combo1 & Chr(34) & vbCrLf
Text2 = Text2 & "Size = 9.75" & vbCrLf
Text2 = Text2 & "Charset = 0" & vbCrLf
Text2 = Text2 & "Weight = 400" & vbCrLf
Text2 = Text2 & "Underline = 0" & vbCrLf
Text2 = Text2 & "Italic = 0" & vbCrLf
Text2 = Text2 & "Strikethrough = 0" & vbCrLf
Text2 = Text2 & "EndProperty" & vbCrLf
End Sub
Private Sub Combo1_Click()
On Error Resume Next
Command1.Font = Combo1
End Sub
Private Sub Command1_Click()
Text2 = ""
Open Text1 For Input As #1
Line Input #1, linea1
Line Input #1, linea2
Text2 = Text2 & linea1 & vbCrLf
Text2 = Text2 & linea2 & vbCrLf
Do
Line Input #1, linea
If linea Like "*egin VB.*" Then 'Es control ?
Text2 = Text2 & linea & vbCrLf
Line Input #1, linea
If linea Like "*aption*" Then ' Revisar si es Caption
Text2 = Text2 & linea & vbCrLf
' Leer la siguiente linea para ver si ya tiene fuente
Line Input #1, linea
End If
If linea Like "*eginProperty Fon*" Then ' Tiene fuente ?
Text2 = Text2 & linea & vbCrLf
' Poner nueva fuente
Text2 = Text2 & "Name = " & Chr(34) & Combo1 & Chr(34) & vbCrLf
' Leer las siguientes 7 lineas para dejar preferencias anteriores
For i = 1 To 7
Line Input #1, linea
Text2 = Text2 & linea & vbCrLf
Next i
Else ' Si no tiene fuente...
Agrega ' Insertar fuente nueva
Text2 = Text2 & linea & vbCrLf
End If
Else ' Si no es control seguir normal...
Text2 = Text2 & linea & vbCrLf
End If
Loop Until EOF(1)
Close #1
' guardar el archivo
Open Text1 For Output As #2
Print #2, Text2
Close #2
End Sub
Private Sub Form_Load()
For i = 0 To Screen.FontCount - 1
Combo1.AddItem Screen.Fonts(i)
Next i
Combo1 = "MS Sans Serif"
End Sub